Finde filer med makro(er) i

Hej

Her er et forslag t/dit første spørgsmål.
Det anførte drev undersøges for xls.filer - derefter undersøges om der er kodelinier i de forskellige projekt-objekter. Hvis dette er tilfældet vises navnet pr. fil i en meddelelse.

Koden kan indsættes som modul i et tomt regneark:

- - - - - - -
Sub test()
    soegXlsFiler
End Sub
Private Function makrotest()
Dim f, al
    For f = 1 To Application.VBE.CodePanes.Count
        If Application.VBE.CodePanes(f).CodeModule.CountOfLines > 0 Then
            makrotest = True
            Exit Function
        End If
    Next f
    makrotest = False
End Function
Sub soegXlsFiler()
    Set fs = Application.FileSearch
    With fs
        .LookIn = "d:\"          'HER SKAL DU SELV ÆNDRE DREV-BETEGNELSEN
        .FileName = "*.xls"
        .SearchSubFolders = True
       
        If .Execute() > 0 Then
            With Application.FileSearch
                For i = 1 To .FoundFiles.Count
                    If makrotest = True Then
                        MsgBox .FoundFiles(i)
                    End If
                Next i
            End With
        End If
    End With
End Sub

- - -
Kan eksekveres via Alt+F8 - eller indsæt en knap i arket.

Vedr. spørgsmål 2 - kan dette også lade sig gøre v/udbygning af ovennævnte.

Er udviklet via office97.

MVH

Kan ikke helt forstå, hvis du kan få det til at virke Supertekst, men din approach er ok.

For at undersøge om der er makroer i mener jeg at det er nødvendigt at åbne filerne.
Jeg har bygget din makro lidt om så dette sker og så den samtidig kopierer filerne med makroer til et nyt biblioket (newdir)

Public Function CodeFind(ProjMappe) As Boolean
    CodeFind = False
    Set wb = Workbooks.Open(ProjMappe)
    For x = wb.VBProject.VBComponents.Count To 1 Step -1
        a = wb.VBProject.VBComponents(x).CodeModule.CountOfLines
        If a > 2 Then
          CodeFind = True
          Debug.Print a
          Exit For
        End If
    Next x
    wb.Close savechanges:=False
End Function

Sub soegXlsFiler()
Dim test As Boolean, fname As String
Application.ScreenUpdating = False
    newdir = "C:\test\"
    Set fs = Application.FileSearch
    With fs
        .LookIn = "d:\"
        .filename = "*.xls"
        .SearchSubFolders = True
        If .Execute() > 0 Then
            With Application.FileSearch
                For i = 1 To .FoundFiles.Count
                    test = CodeFind(.FoundFiles(i))
                    If test = True Then
                        a = Split(.FoundFiles(i), "\")
                        fname = a(UBound(a))
                        FileCopy .FoundFiles(i), newdir & fname
                    End If
                Next i
            End With
        End If
    End With
End Sub

Glemte lige at skrive at makroen ikke kan køre i xl97, da denne version ikke har funktionen Split, men det kan da heldigvis omgåes hvis det er aktuelt.

Hej bak
når jeg kører makroen får jeg en fejlbesked:
"run-time-error 1004, automatisk adgang til visual basic-projektet er ikke pålidelig" og makroen stopper ?
mvh
alj

sorry Hej bak og supertekst burde der have stået

Gå i Funktioner/Makro/Sikkerhed på fanebladet "Pålidelige kilder" og sæt flueben i "Giv adgang til visual basic projekt"

Tak bak, det hjalp.
Må jeg høfligst bede om et svar fra Jer ?
mvh
Alan

Er I på ferie eller ?
Må jeg høfligst bede om et svar fra Jer ?
mvh
Alan

Hej Alan

Undskyld - her kommer et lige så høfligt svar!

Med venlig hilsen
Peter Braagaard

Glimrende supertekst,
så mangler vi bare at høre fra bak

da jeg synes der skal være "lidt" til begge
mvh
alj

tak for det .... :-)

Jamen dog, det lykkedes her inden man skal hjem og slappe af.

I skal begge have 1000-tak for hjælpen.

Ka' I hygge Jer.
mvh alan