Option Explicit
Sub Dateisuche()
Dim Suche As String
Suche = InputBox("Bitte Suchbegriff eingeben", Suche)
If Suche <> "" Then
LoopThroughFolder "C:\Users\tw\Documents", Suche
End If
End Sub
Public Sub LoopThroughFolder(path As String, Filter As Variant)
Dim fso, oFolder, oSubfolder, oFile, queue As Collection
Dim lngLast As Long
On Error Resume Next
Set fso = CreateObject("Scripting.FileSystemObject")
Set queue = New Collection
queue.Add fso.GetFolder(path)
Do While queue.Count > 0
Set oFolder = queue(1)
queue.Remove 1
For Each oSubfolder In oFolder.SubFolders
If oSubfolder <> vbEmpty Then queue.Add oSubfolder
Next
For Each oFile In oFolder.Files
If oFile <> vbEmpty Then
If IsInArray(fso.GetExtensionName(oFile.path), Filter) Then
With ThisWorkbook.Sheets("Sheet1")
lngLast = .Cells(Rows.Count, 1).End(xlUp).Row + 1
.Cells(lngLast, 2) = oFile.path
.Hyperlinks.Add anchor:=.Cells(lngLast, 1), Address:=oFile.path, TextToDisplay:=oFile.Name
End With
End If
End If
Next
Loop
End Sub
Function IsInArray(str As String, arr As Variant) As Boolean
IsInArray = (UBound(Filter(arr, str)) > -1)
End Function