List All Files and Folders

Dim AllFolders(4000, 30)
Dim Flevel As Integer
Dim rowx As Integer

Sub getallfolders()
startFolder = "S:\Committees"
Flevel = 0
rowx = 0
AllFolders(rowx, Flevel) = startFolder
Call DoAllFolders(startFolder)
ThisWorkbook.Sheets(3).Range("b1").Resize(4000, 30) = AllFolders
End Sub

Sub DoAllFolders(ThisFolder)
Dim fso As New FileSystemObject
Dim Fs As Folder
Dim fsx As Folder
If fso.FolderExists(ThisFolder) = True Then
Set Fs = fso.GetFolder(ThisFolder)
Flevel = Flevel + 1

For Each fsx In Fs.SubFolders
rowx = rowx + 1
bb = fsx.Path
AllFolders(rowx, Flevel) = fsx.Name
DoAllFolders bb
Next
Flevel = Flevel - 1
End If
End Sub
Sub ListAllFiles()
Dim fso As New FileSystemObject
Dim Fs As Folder
Dim fl As File
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = ""
.ButtonName = "Select Folder"
If .Show = -1 Then
SelFolder = .SelectedItems(1)
Else
Exit Sub
End If
End With

With ThisWorkbook.Sheets(1)
.Activate
.Range("A5:f100").ClearContents
FileList = .Range("A5").Resize(100, 1)
If fso.FolderExists(SelFolder) = True Then
Set Fs = fso.GetFolder(SelFolder)

idx = 2
FileList(1, 1) = Fs.Name

For Each fl In Fs.Files
FileList(idx, 1) = fl.Name
idx = idx + 1
Next
End If
.Range("a5").Resize(idx, 1) = FileList
End With
End Sub