XL und Word-Makros auflisten per Makro
Beffen
Ich habe von Rudi bereits eine Idee für einen Code bekommen, wie man aus einem vorgewählten Pfad alle Exceldateien listen kann und herausfinden kann, welche Makros enthalten, und wie sie heissen.
Das klappt schon grundsätzlich recht gut und vielen Dank Rudi!!!
Option Explicit
Sub GetMakroList()
Dim FSO As Object, oFolder As Object
Dim strFolder As String
Application.ScreenUpdating = False
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Ordner wählen"
.AllowMultiSelect = False
If .Show = -1 Then
strFolder = .SelectedItems(1)
End If
End With
If strFolder = "" Then Exit Sub
Set FSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = FSO.GetFolder(strFolder)
ThisWorkbook.Sheets(1).Cells.Clear
prcFiles oFolder
prcSubFolders oFolder
End Sub
Private Sub prcFiles(oFolder)
Dim oFile As Object, wkb As Workbook
For Each oFile In oFolder.Files
If LCase(oFile) Like "*.xls" Then
Set wkb = Workbooks.Open(oFile)
MakroListe wkb
wkb.Close False
End If
Next
End Sub
Private Sub prcSubFolders(oFolder)
Dim oSubFolder As Object
For Each oSubFolder In oFolder.SubFolders
prcFiles oSubFolder
prcSubFolders oSubFolder
Next
End Sub
Private Sub MakroListe(wkb As Workbook)
Dim vbc As Object, iCounter As Long, wks As Worksheet, sLine As String
Dim blnMakro As Boolean
Set wks = ThisWorkbook.Sheets(1)
On Error GoTo errhandler
For Each vbc In wkb.VBProject.VBComponents
With vbc.CodeModule
For iCounter = 1 To .CountOfLines
sLine = Trim(.Lines(iCounter, 1))
If sLine Like "Sub*(*)*" _
Or sLine Like "Public Sub*(*)*" _
Or sLine Like "Private Sub*(*)*" _
Or sLine Like "Function*(*)*" _
Or sLine Like "Public Function*(*)*" _
Or sLine Like "Private Function*(*)*" Then
blnMakro = True
With wks.Cells(Rows.Count, 1).End(xlUp)
.Offset(1, 0) = wkb.FullName
.Offset(1, 1) = sLine
End With
End If
Next iCounter
End With
Next vbc
If Not blnMakro Then
With wks.Cells(Rows.Count, 1).End(xlUp)
.Offset(1, 0) = wkb.FullName
.Offset(1, 1) = "No Makro"
End With
End If
errhandler:
If Err.Number > 0 Then
MsgBox Err.Description, , "Fehler"
End If
End Sub
Allerdings nicht bei allen Servern unseres Systemes. :-( Ich habe schon versucht eine Fehlerbehandlung einzubauen, leider ohne Erfolg. Des Häufigeren kommt der Fehler: "Index ausserhalb des gültigen Bereichs". Ein weiteres Problem ist, dass nicht nur XL-Dateien Makros enthalten, sondern auch Doc und Access-Dateien. Wiederum habe ich selbst probiert und es wurden der Variable wkb auch tatsächlich gefundene Dokumente aus Word zugeteilt, jedoch kann ich mit "Workbooks.open..." ja kein Dokument öffnen. documents.open brachte auch keinen Erfolg und auch weitergehende Änderungen nicht....
Hat jemand noch ne Idee, wie ich alle Office Dokumente (in jedem Fall aber xl und Word) nach Makros durchsuchen kann?Mit XL klappts ja schon sehr gut....
Danke an Alle, die sich die Zeit nehmen!
Gruß Beffen