Sub MainList()
Dim folder
Dim xDir
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)
ActiveSheet.UsedRange.EntireColumn.AutoFit
Application.ScreenUpdating = True
End Sub
Sub ListFilesInFolder(ByVal xFolderName As String)
Dim xFileSystemObject As Object
Dim xFolder As Object
Dim xSubFolder As Object
Set xFileSystemObject = CreateObject("Scripting.FileSystemObject")
Set xFolder = xFileSystemObject.GetFolder(xFolderName)
For Each xSubFolder In xFolder.SubFolders
With Application.ActiveSheet
.Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0).Value = xSubFolder.Name
End With
ListFilesInFolder xSubFolder.Path
Next xSubFolder
Set xFolder = Nothing
Set xFileSystemObject = Nothing
End Sub