Ist ein Makro in der Datei vorhanden?

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Hallo
Hier mein Versuch:
Alle Dateien nacheinander öffnen.
VBA-project ohne Schutz dann:
Untersuchen auf Module, Klassenmodule, Userforms.
Klassenmodule untersuchen ob mehr zeilen als die declarationszeilen vorhanden sind.
Wenn 1 von beiden dann die Datei aufnehmen in arr.

' **********************************************************************
' Modul: Tabelle1 Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************

Option Explicit

Public Sub test()
Dim FSO As Object
Dim WB As Workbook
Dim exlApp As Object
Dim vbCom As Object
Dim arr As Variant
Dim I As Integer
On Error GoTo raus
Set exlApp = CreateObject("Excel.Application")
Set FSO = CreateObject("Scripting.FilesystemObject")
Dim Datei As Object
With exlApp
    Set WB = exlApp.Workbooks.Add
    .Calculation = xlCalculationManual
    .EnableEvents = False
    .DisplayAlerts = False
    .ScreenUpdating = False
    Redim arr(1 To FSO.getfolder("C:\Users\Dein_Pfad\makros").Files.Count)
    For Each Datei In FSO.getfolder("C:\Users\Dein_Pfad\makros").Files
        If FSO.getextensionname(Datei) = "xls" Then
            Set WB = .Workbooks.Open(Datei, False, True)
            If WB.VBProject.Protection = 0 Then
                For Each vbCom In WB.VBProject.VBComponents
                    Select Case vbCom.Type
                        Case 1 To 3 'Klassenmodule, Userforms, Standardmodule
                            I = I + 1
                            Set arr(I) = Datei
                            Exit For
                        Case 100
                            If vbCom.CodeModule.CountOfLines > vbCom.CodeModule.CountOfDeclarationLines Then
                                I = I + 1
                                Set arr(I) = Datei
                                Exit For
                            End If
                    End Select
                Next
            End If
            WB.Close False
        End If
    Next
End With
raus:
exlApp.Quit
Redim Preserve arr(I)
MsgBox Join(arr, vbCrLf)
End Sub

ransi

Beliebteste Forumthreads (12 Monate)

Ist ein Makro in der Datei vorhanden?

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Ist ein Makro in der Datei vorhanden?

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread