Dateisuche nach Datentypen (mit Unterordner)

Option Compare Text 'benötigt für einen 'like' Vergleich  

Dim fso As Object 'Variable ganz am Anfang des Codefensters stehen lassen !  

Sub SearchForAll()
'Variablen Deklarieren  
Dim strFolderPath As String, strFileFilter As String, strEmpty
Dim objFoundFiles As Collection


'FilesystemObject erstellen  
Set fso = CreateObject("Scripting.Filesystemobject")  

'Button erstellen  

'Ordner Verzeichnis auswählen  
 strFolderPath = fncBrowseForFolder

'Inputbox wird erstellt in der das Suchwort eingegeben werden soll  
 'strFileFilter = InputBox("Dateinamensteileingeben :" & Chr(13) & "z.B. Eingabe_* (ohne Datei-Erweiterung, es werden nur *.xlsx,und *.xls Dateien gesucht)")  

'strEmpty Wert zuweisen  
strEmpty = ""  

'Suche Dateien mit passenden Namen  
    enumFiles fso.GetFolder(strFolderPath), strEmpty, objFoundFiles
    
    If objFoundFiles.Count > 0 Then
    MsgBox "Es wurden " & objFoundFiles.Count & " gefunden!"  
    End If
    


'Neue Worksheet erstellen das "Output" heißt  
'Worksheets.Add before:=Worksheets(1)  
'ActiveSheet.Name = "Output"  

End Sub

' Öffnet das Suchfeld für die Ordnerauswahl  


Private Function fncBrowseForFolder(Optional ByVal defaultPath = "") As String  

  Dim objFlderItem As Object, objShell As Object, objFlder As Object


  Set objShell = CreateObject("Shell.Application") 'Vordefinierter Pfad einstellen zu Testzwecken (Standard--> DefaultPath)  
  Set objFlder = objShell.BrowseForFolder(0&, "Ordner auswählen...", 0&, "I:\Projects-Global\ITIS\IT37639_Logbuch_Zusammenfuehrung\090_Infos_Intern\Gleiche_Logbuecher_Test")  

  If objFlder Is Nothing Then GoTo ErrExit

  Set objFlderItem = objFlder.Self
  fncBrowseForFolder = objFlderItem.Path

ErrExit:
  Set objShell = Nothing
  Set objFlder = Nothing
  Set objFlderItem = Nothing

End Function

'Funktion um Dateien rekursiv zu suchen  

Sub enumFiles(ByVal RootFolder As Object, ByVal strFilter As String, ByRef col As Collection)

    On Error Resume Next
    For Each file In RootFolder.Files
        ext = LCase(fso.GetExtensionName(file.Name))
        If fso.GetFileName(file.Name) Like strFilter Or (ext = "xlsx" Or ext = "xls") Then  
            col.Add file.Path
        End If
    Next
    'Unterordner Suche falls vorhanden  
    For Each subfolder In RootFolder.SubFolders
        enumFiles subfolder, strFilter, col
    Next

End Sub