Dir und Unterverzeichnisse - von Ramses am 18.

Sub Find_Files_with_Textfragment()
Dim i As Long
Dim gefFile As String, dname As String
Dim Suchpfad As String, Suchbegriff As String, Dateiform As String
Dim oldStatus As Variant, myMatch As Boolean, msgTxt As String, Qe As Variant
Suchpfad = InputBox("Geben Sie den Ordner an, der durchsucht werden soll:", "Pfad definieren", Application.DefaultFilePath)
If Suchpfad = "" Then Exit Sub
Dateiform = InputBox("Geben Sie den Dateityp an der gesucht werden soll", "Dateierweiterung", "*.xls")
If Dateiform = "" Then Exit Sub
Suchbegriff = InputBox("Geben Sie den Text an der in den Dateien gesucht werden soll", "Textfragment", "")
If Suchbegriff = "" Then Exit Sub
msgTxt = "Soll auf exakte Übereinstimmung mit dem Dateinamen gesucht werden ? "
msgTxt = msgTxt & vbCrLf & "Bei ""Nein"" werden als Ergebnis auch Dateien angezeigt,"
msgTxt = msgTxt & vbCrLf & "bei denen nur ein Teil des Namens mit:"" " & Suchbegriff & " "" übereinstimmt !"
Qe = MsgBox(msgTxt, vbQuestion + vbYesNo, "Suchroutine")
If Qe = vbOK Then
myMatch = True
Else
myMatch = False
End If
'Bildschirmaktualisier abschalten
Application.ScreenUpdating = True
'Text der Statusbar und alten Status aufnehmen
oldStatus = Application.StatusBar
'Start der Suchroutine
With Application.FileSearch
.NewSearch
.LookIn = Suchpfad
.TextOrProperty = Suchbegriff
.SearchSubFolders = True
' = True wenn der Suchbegriff GENAU übereinstimmen soll
' = False wenn nur ein Teil des Dateinamens übereinstimmen soll
.MatchTextExactly = myMatch
.FileType = Dateiform
If .Execute() > 0 Then
totFiles = .FoundFiles.count
'Ausgabe in Statusbar
Application.StatusBar = "Total " & totFiles & " gefunden"
For i = 1 To .FoundFiles.count
gefFile = .FoundFiles(i)
'In Listbox eintragen mit der AddItem Methode
Me.ListBox1.AddItem (gefFile)
Next i
End If
End With
End Sub