Ordnerinhalt in Tabelle schreiben

Private Sub CommandButton1_Click()
Dim pfad As String, such As String
Dim Text As String, xxl As String
Dim i As Integer, y As Integer, z As Integer
Dim info As Integer, x As Integer, anz As Integer
Dim fs
Set fs = Application.FileSearch
pfad = ThisWorkbook.Path
With fs
.LookIn = pfad
.SearchSubFolders = True
.Filename = "*.*"
If .Execute(SortBy:=msoSortByFileName, _
SortOrder:=msoSortOrderAscending) > 0 Then
z = Len(.LookIn)
such = "\"
Cells(2, 2) = pfad & " " & .FoundFiles.Count & " Dateien"
y = 3
For i = 1 To .FoundFiles.Count
Cells(y, 2) = .FoundFiles(i)
Text = Cells(y, 2)
anz = Len(Cells(y, 2))
such = "\"
For x = 1 To anz
info = InStr(info + 1, Text, such)
If info = 0 Then GoTo weiter
Cells(y, 2) = Right(Text, anz - info)
xxl = Cells(y, 2)
With ActiveSheet
.Hyperlinks.Add Anchor:=.Cells(y, 2), Address:=Text, _
TextToDisplay:=xxl
End With
Next x
weiter:
y = y + 1
Next i
Columns("B:B").AutoFit
Else
MsgBox "Keine Dateien gefunden"
End If
End With
With Columns("B:B").Font
.name = "Arial"
.FontStyle = "Standard"
.Underline = xlUnderlineStyleNone
.ColorIndex = 5
End With
With Cells(2, 2).Font
.name = "Arial"
.FontStyle = "Standard"
.Size = 10
.ColorIndex = xlAutomatic
.Bold = True
End With
End Sub