Excel文件目录抓取器

目前我有一个工作簿devise索引一个文件夹，在文件夹path例如'Z：\ Example'中input，它将该文件夹中的所有文件名和文件path导出到工作簿中的另一个工作表中。 我想知道是否可以抓取该文件夹中的所有文件（'Z：\ Example'），如果该目录内还有其他文件夹，也可以抓取该文件夹中的所有文件。

例如，我在单元格A19中input'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 

我宁愿不必插入所有我想要在开始索引的path，但如果这是不可避免的，那就好了。 任何帮助赞赏。

谢谢

Answer 1

如在评论中，有许多资源列出文件夹及其子文件夹。 这段代码是根据您的应用程序定制的。 它使用recursion，并需要被馈送到根文件夹和粘贴结果的目标单元格。

 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