Function GetFolderPath(Optional ByVal Title As String = "Выберите папку", _
Optional ByVal InitialPath As String = "c:\") As String
' функция выводит диалоговое окно выбора папки с заголовком Title,
' начиная обзор диска с папки InitialPath
' возвращает полный путь к выбранной папке, или пустую строку в случае отказа от выбора
Dim PS As String: PS = Application.PathSeparator
With Application.FileDialog(msoFileDialogFolderPicker)
If Not Right$(InitialPath, 1) = PS Then InitialPath = InitialPath & PS
.ButtonName = "Выбрать": .Title = Title: .InitialFileName = InitialPath
If .Show <> -1 Then Exit Function
GetFolderPath = .SelectedItems(1)
If Not Right$(GetFolderPath, 1) = PS Then GetFolderPath = GetFolderPath & PS
End With
End Function

Sub GetAllFileNamesDict(FolderPath$, ByVal SearchDeep%, FSO, oDict1, oDict2)
Dim oFile, oCurFolder, oSubFolder
On Error Resume Next
Set oCurFolder = FSO.GetFolder(FolderPath)
If Not oCurFolder Is Nothing Then 'чтобы не зациклилось при рекурсивном вызове, когда нет подпапок и oSubFolder=Nothing
Application.StatusBar = "Поиск в папке: " & FolderPath ' вывод пути к просматриваемой в текущий момент папке в строку состояния Excel
For Each oFile In oCurFolder.Files ' перебираем все файлы в папке FolderPath
With oFile
oDict1.Item(oDict1.count + 1) = .Path
oDict2.Item(oDict2.count + 1) = .Name
End With
Next oFile
SearchDeep = SearchDeep - 1 ' один уровень поиска прошли
If SearchDeep Then ' если надо искать в подпапках глубже
For Each oSubFolder In oCurFolder.SubFolders ' перебираем все подпапки в папке FolderPath
GetAllFileNamesDict oSubFolder.Path, SearchDeep, FSO, oDict1, oDict2
Next oSubFolder
End If
End If
Set oFile = Nothing: Set oCurFolder = Nothing: Set oSubFolder = Nothing
DoEvents ' чтобы можно было прервать слишком длинную рекурсию
End Sub