Sub MainList()
Worksheets(1).UsedRange.ClearContents
Application.ScreenUpdating = False
Set folder = Application.FileDialog(msoFileDialogFolderPicker)
If folder.Show <> -1 Then Exit Sub
xDir = folder.SelectedItems(1)
Call ListFilesInFolder(xDir, 1)
ActiveSheet.UsedRange.EntireColumn.AutoFit
Application.ScreenUpdating = True
End Sub
Sub ListFilesInFolder(ByVal xFolderName As String, ByVal Spalte As Integer)
Dim xFileSystemObject As Object
Dim xFolder As Object
Dim xSubFolder As Oabject
Set xFileSystemObject = CreateObject("Scripting.FileSystemObject")
Set xFolder = xFileSystemObject.GetFolder(xFolderName)
For Each xSubFolder In xFolder.SubFolders
letztezeile = Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1
Application.ActiveSheet.Cells(letztezeile, Spalte).Formula = xSubFolder.Name
ListFilesInFolder xSubFolder.Path, Spalte + 1
Next xSubFolder
Set xFolder = Nothing
Set xFileSystemObject = Nothing
End Sub