Чтение путей к файлам из папок и подпапок в Excel

Question

Я использую следующий код для чтения имен файлов в лист Excel, но я хотел бы включить подпапки и захватить весь путь к файлу. Я попробовал несколько вещей, но ни одна не сработала. Я собрал это воедино из фрагментов чужого кода, отредактированного для работы в моей ситуации, к сожалению, это означает, что мое понимание не так тщательно, как должно быть.

Файлы представляют собой аудиофайлы (wav или mp3), остальная часть электронной таблицы будет содержать метаданные, которые будут использоваться для маркировки файлов: исполнитель, название, альбом и т. Д.

Option Explicit
Sub GetFileNames()
Dim xRow As Long
Dim xDirect$, xFname$, InitialFoldr$
InitialFoldr$ = "C:\"

 With Application.FileDialog(msoFileDialogFolderPicker)
 .InitialFileName = Application.DefaultFilePath & "\"
 .Title = "Please select the folder to list audio files from"
 .InitialFileName = InitialFoldr$
 .Show

  If .SelectedItems.Count <> 0 Then
  xDirect$ = .SelectedItems(1) & "\"
  xFname$ = Dir(xDirect$, 7)
  Do While xFname$ <> ""
  Worksheets("Metadata").Activate
  ActiveSheet.Range("A2").Select
  ActiveCell.Offset(xRow) = xFname$
  xRow = xRow + 1
  xFname$ = Dir
  Loop

   Dim x&
    With Application
            .ScreenUpdating = False
            Rows.Hidden = False
            Rows.Hidden = True
        For x = 1 To Rows.Count
            If .WorksheetFunction.CountA(Rows(x)) > 0 Then Rows(x).Hidden = False
        Next x
        .ScreenUpdating = False
    End With

   Worksheets("Metadata").Visible = True
   Worksheets("Menu").Visible = False

End If
End With
End Sub

Я очень плохо знаком с VBA, но начинаю понимать его части.

Answer 1

Этот код извлечет все mp3-файлы из папки и всех ее подпапок. Удачи с VBA!

Public Sub FindFiles()
'you must add a reference to 'Microsoft Shell Controls And Automation'

Dim shl As Shell32.Shell
Dim fol As Shell32.Folder
Dim row As Long

Set shl = New Shell32.Shell
Set fol = shl.Namespace("E:\CDs\")
row = 1

ProcessFolderRecursively fol, row

End Sub

Private Sub ProcessFolderRecursively(fol As Shell32.Folder, ByRef row As Long)

Dim item As Shell32.FolderItem
Dim fol2 As Shell32.Folder

If Not fol Is Nothing Then
    For Each item In fol.Items
        If item.IsFolder Then
            Set fol2 = item.GetFolder
            ProcessFolderRecursively fol2, row
        Else
            'you might need to edit the criterion here
            If item.Type = "MP3 Format Sound" Then
                Cells(row, 1) = item.Path
                row = row + 1
            End If
        End If
    Next
End If

End Sub