从文件夹中读取文件路径&子文件夹到Excel

时间:2014-04-25 15:19:13

标签: excel vba directory filepath subdirectory

我正在使用以下代码将文件名读取到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很新,但我开始抓住它的一部分。

1 个答案:

答案 0 :(得分:0)

此代码将从文件夹及其所有子文件夹中提取所有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