Excel文件目录抓取器

Question

目前我有一个旨在索引文件夹的工作簿，您可以在其中输入文件夹路径，例如'Z:\Example' 并将该特定文件夹中所有内容的所有文件名和文件路径导出到工作簿中的另一个工作表中。我想知道是否可以抓取该文件夹中的所有文件（'Z:\Example'），如果该目录中有任何其他文件夹，也可以抓取该文件夹中的所有文件。

例如我在单元格 A19 中输入“Z:\Example”（按照下面的代码）， 'Z:\Example' 中有另一个文件夹，Z:\Example\Another'。所有文件 在 'Z:\Example' 和 Z:\Example\Another' 中都被带入 excel表2。

Private Sub CommandButton1_Click()

    Dim objFSO As Object
    Dim objFolder As Object
    Dim objFile As Object
    Dim i As Integer
    Dim Source_Workbook As Workbook
    Dim Target_Path As String

    'Create an instance of the FileSystemObject
    Set objFSO = CreateObject("Scripting.FileSystemObject")

    'Path of the Target Folder
    Target_Path = Range("A19").Value

    Set Target_Workbook = Workbooks.Open(Target_Path)
    Set Source_Workbook = ThisWorkbook

    'Get the folder object

    Set objFolder = objFSO.GetFolder(Target_Path)
    i = 1
    'loops through each file in the directory and prints their names and path

    For Each objFile In objFolder.Files
        'print file name
        Source_Workbook.Sheets(2).Cells(i + 1, 1) = objFile.Name
        'print file path
        Source_Workbook.Sheets(2).Cells(i + 1, 2) = objFile.Path
        i = i + 1
    Next objFile

    'Process Completed
    msgBox "Task Completed"
End Sub

我宁愿不必在开头插入我想要索引的所有路径，但如果这是不可避免的，那没关系。任何帮助表示赞赏。

谢谢

Answer 1

在 cmets 中，有很多资源可以列出文件夹及其子文件夹。这个 sn-p 是为您的应用程序定制的。它使用递归，需要提供根文件夹和粘贴结果的目标单元格。

Private Sub CommandButton1_Click()
    'Call the recursive function
    ListAllFiles ThisWorkbook.Sheets(1).Range("A19").Value, ThisWorkbook.Sheets(2).Cells(2, 1)
    msgBox "Task Completed"
End Sub


Private Sub ListAllFiles(root As String, targetCell As Range)
    Dim objFSO As Object, objFolder As Object, objSubfolder As Object, objFile As Object
    Dim i As Integer, Target_Path As String

    'Create an instance of the FileSystemObject
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    'Get the folder object
    Set objFolder = objFSO.GetFolder(root)
    'loops through each file in the directory and prints their names and path

    For Each objFile In objFolder.Files
        'print file name
        targetCell.Value = objFile.Name
        'print file path
        targetCell.Offset(, 1).Value = objFile.Path
        Set targetCell = targetCell.Offset(1)
    Next objFile

    ' Recursively call the function for subfolders
    For Each objSubfolder In objFolder.SubFolders
        ListAllFiles objSubfolder.Path, targetCell
    Next objSubfolder
End Sub