Gruppe
Datei
Problem
Die in Spalte A genannten Verzeichnisse sollen gem. den Kriterien in Spalte D durchsucht und die gefundenen Dateien in einer neuen Arbeitsmappe mit Hyperlinks gelistet werden.
StandardModule: Modul1
Sub GrepFiles()
Dim wks As Worksheet
Dim iCounter As Integer, iRow As Integer
Set wks = ActiveSheet
iRow = 2
Workbooks.Add 1
Do Until IsEmpty(wks.Cells(iRow, 1))
With Application.FileSearch
.NewSearch
.LookIn = wks.Cells(iRow, 1).Value
.Filename = wks.Range("D1").Value
.MatchTextExactly = True
.TextOrProperty = wks.Range("D2").Value
.SearchSubFolders = wks.Range("D3").Value
.Execute
For iCounter = 1 To .FoundFiles.Count
Cells(iCounter, 6).Value = .FoundFiles(iCounter)
ActiveSheet.Hyperlinks.Add Cells(iCounter, 6), .FoundFiles(iCounter)
Next iCounter
End With
iRow = iRow + 1
Loop
End Sub