Code anpassen

Option Explicit 
 
Dim i As Long 
Dim k As Long 
 
Sub dateien_auflisten() 
 Dim objShell, objFolder 
 Dim BrowseDir, varName 
 Set objShell = CreateObject("Shell.Application") 
 Set BrowseDir = objShell.BrowseForFolder(0, "Ordner auswählen", &H1000, 17) 
 If Not BrowseDir Is Nothing Then 
 Application.ScreenUpdating = False 
 Cells.Clear 
 i = 0 
 Set objFolder = objShell.Namespace(BrowseDir.items().Item().Path) 
 i = i + 1 
 Cells(i, 1) = "Pfad" 
 For k = 1 To 50 
 Cells(i, k + 1) = objFolder.GetDetailsOf(, k) 
 Next 
 Set objFolder = Nothing 
 If MsgBox("Unterordner duchsuchen?", vbYesNo, "Abfrage") = vbYes Then 
 rekursiv BrowseDir.items().Item().Path, True 
 Else 
 rekursiv BrowseDir.items().Item().Path, False 
 End If 
 Application.ScreenUpdating = True 
 Columns.AutoFit 
 End If 
 Set objShell = Nothing 
End Sub 
Function rekursiv(ordner, unterordner As Boolean) 
 Set objShell = CreateObject("Shell.Application") 
 Set objFolder = objShell.Namespace(ordner) 
 For Each varName In objFolder.items 
 If varName.Type = "Dateiordner" And unterordner = True Then 
 rekursiv varName.Path, True 
 ElseIf varName.Type <> "Dateiordner" Then 
 i = i + 1 
 textbox2 = varName.Path 
 For k = 1 To 50 
 Cells(i, k + 1) = objFolder.GetDetailsOf(varName, k) 
 Next 
 End If 
 Next 
 Set objFolder = Nothing 
End Function