Dachte Ich mir schon fast... macht aber nix, habs Dir einigermaßen noch kommentiert:
Option Explicit
'*** modulweite Deklaration
Private fso As Object
'***
Sub main()
'*** Definitionsteil
Set fso = CreateObject("Scripting.FileSystemObject")
'*** Bei durchlauf Worksheet leeren und Überschriften setzen
With ThisWorkbook.Worksheets(1)
.Cells.Clear
.Range("A1").Value = "Pfad und Link"
.Range("A1").Value = "Dateiname"
End With
'*** Startordner und dessen Unterordner durchsuchen
DurchsucheOrdner "C:\Test\" '<~~ anzupassen
End Sub
Sub DurchsucheOrdner(ByVal sPfad As String)
Dim fil As Object
Dim fldr As Object
'*** Prozedur durchsucht Ordner nach Unterordner und ruft sich selbst bei Fund wiedre auf
For Each fldr In fso.GetFolder(sPfad).SubFolders
Call DurchsucheOrdner(fldr.Path)
Next fldr
'*** Durchsuche Ordner nach Dateien
'*** Schreibe Dateiname und Hyperlink ins Tabellenblatt
For Each fil In fso.GetFolder(sPfad).Files
With ThisWorkbook.Worksheets(1).Cells(Rows.Count, 1).End(xlUp)
'*** Hyperlink
.Parent.Hyperlinks.Add Anchor:=.Offset(1, 0), Address:=fil.Path
'*** Dateiname
.Offset(1, 1).Value = fil.Name
End With
Next
End Sub
|