Wie Unterverzeichnisse einlesen

Private Function GetAOrdner() As String
GetAOrdner = "c:\"
With Application.FileSearch
.SearchSubFolders = True ' Unterordner mit angeben
End With
End Function

Function GetFilename(DateinameMitPfad)
GetFilename = Mid(DateinameMitPfad, InStrRev(DateinameMitPfad, "\", -1) + 1)
End Function

Sub DateienAuflisten()
Dim intZahl As Integer
Dim strPfad As String
Dim intIcount As Integer
Dim strName As String
strPfad = GetAOrdner
If strPfad = "" Then Exit Sub
With Application.FileSearch
intIcount = .FoundFiles.Count
For intZahl = 30 To intIcount ' Ab Zeile 30 einfügen Spalte B
Worksheets(1).Hyperlinks.Add anchor:=Worksheets(1).Cells(intZahl, 2), _
Address:=.FoundFiles(intZahl)
Next intZahl
End With
On Error GoTo 0
Exit Sub
End Sub