我有一个用户表单，可以将文件夹路径粘贴到列表中。然后我有下面的代码，它应该循环遍历该列表并列出所有子文件夹（然后我可能会在子文件夹中有另一个代码循环来获取excel工作簿）。
我知道它不优雅，因为最终我想要的是让我的路径列表一次查看，通过每个文件夹和子文件夹来查找和列出excel文件。但是有a question之类的东西被删除了。然后将问题提到to a different q&a，我不明白，这与单个文件名称有关，键入单个单元格而不是范围，也不是路径。我说俄语，他的一些代码所在，但仍然无法理解他的代码的意思和指示，当我尝试它时，它一直在告诉我们＃34; GetData＆＃34;未定义？所以我试图提出一个不同但相似的问题，希望有人可以向我解释我需要做什么，因为我已经尽我所能并试图调整两个代码。这篇文章中的链接以及许多其他内容。我有几个代码不通的模块不起作用，而我最接近的代码是下面的代码。在这一点上，我只是想办法从路径列表中列出excel文件名。
Option Explicit
Dim i As Long, j As Long
Dim searchfolders As Variant
Dim FileSystemObject
Sub ListOfFolders77()
Dim LookInTheFolder As String
'Dim ws As Worksheet: Set ws = Sheets("Output4")
Dim ws2 As Worksheet: Set ws2 = Sheets("Output3")
Dim rng As Range: Set rng = ws2.Range("A1:A" & Rows.Count).End(xlUp)
Dim mypath As Range
'Dim Region As Range: Set Region = ws.Range("A2")
'Dim district As Range: Set district = ws.Range("B2")
'Dim city As Range: Set city = ws.Range("C2")
'Dim atlas As Range: Set atlas = ws.Range("D2")
i = 1
For Each mypath In rng
LookInTheFolder = mypath.Value
Set FileSystemObject = CreateObject("Scripting.FileSystemObject")
For Each searchfolders In FileSystemObject.GetFolder(LookInTheFolder).subfolders
Sheets("Subfolders").Cells(i, 1) = searchfolders
i = i + 1
SearchWithin searchfolders
Next searchfolders
Next mypath
End Sub
Sub SearchWithin(searchfolders)
On Error GoTo exits
For Each searchfolders In FileSystemObject.GetFolder(searchfolders).subfolders
j = UBound(Split(searchfolders, "\"))
Cells(i, j) = searchfolders
i = i + 1
SearchWithin searchfolders
Next searchfolders
exits:
End Sub
理想情况下，我希望获取文件夹和子文件夹中的所有excel文件，并将第一张工作表上的数据复制粘贴到一个长列表中，但我仍然在第1步。我发布了更详细的解释{ {3}}上周尚未收到任何反馈或潜在提示。
如果这没有意义或似乎有一半危险，我道歉。我是excel VBA的自学者，我很难理解我的需要是否可能。我尝试使用Directory但是我在每个循环中将目录放入a中都没有成功。 我还尝试使用一个阵列，它几乎被计算机崩溃，因为它列出了我整个计算机中的所有文件夹和文件。
答案 0 :(得分：1)
这是一个快速的方式，略微改编自this answer。
只需将您的文件夹位置添加到path() = ...列表，它就适合您。它在当前的Excel工作表中输出您提供的文件夹中所有Excel文件的路径。
从那里，你可以做你想做的事。 （也许将文件路径放入一个数组中，因此你有一个要打开的文件数组。从那里你可以复制数据。）
'Force the explicit delcaration of variables
Option Explicit
Sub ListFiles()
'http://www.xl-central.com/list-the-files-in-a-folder-and-subfolders.html
'Set a reference to Microsoft Scripting Runtime by using
'Tools > References in the Visual Basic Editor (Alt+F11)
'Declare the variables
Dim objFSO As Scripting.FileSystemObject
Dim objTopFolder As Scripting.Folder
Dim strTopFolderName As String
Dim path() As Variant ' EDIT THE BELOW PATH LIST FOR WHATEVER YOU NEED!
path() = Array("C:\Users\USERNAME\Desktop\Stuff\New folder", "C:\Users\USERNAME\Desktop\Other Stuff\")
'Insert the headers for Columns
Range("A1").Value = "File Name"
Range("D1").Value = "File Path"
Dim i As Long
For i = LBound(path) To UBound(path)
strTopFolderName = path(i)
'Create an instance of the FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Get the top folder
Set objTopFolder = objFSO.GetFolder(strTopFolderName)
'Call the RecursiveFolder routine
Call RecursiveFolder(objTopFolder, True)
'Change the width of the columns to achieve the best fit
Columns.AutoFit
Next i
End Sub
Sub RecursiveFolder(objFolder As Scripting.Folder, _
IncludeSubFolders As Boolean)
'Declare the variables
Dim objFile As Scripting.File
Dim objSubFolder As Scripting.Folder
Dim NextRow As Long
'Find the next available row
NextRow = Cells(Rows.Count, "A").End(xlUp).Row + 1
'Loop through each file in the folder
For Each objFile In objFolder.Files
Debug.Print (objFile)
If objFile.Type = "Microsoft Excel Worksheet" Then
Cells(NextRow, "A").Value = objFile.Name
Cells(NextRow, "D").Value = objFile.path
NextRow = NextRow + 1
End If
Next objFile
'Loop through files in the subfolders
If IncludeSubFolders Then
For Each objSubFolder In objFolder.SubFolders
Call RecursiveFolder(objSubFolder, True)
Next objSubFolder
End If
End Sub
答案 1 :(得分：1)
如果我理解正确，您的要求如下：
让我们从前两点开始。我建议使用以下代码（确保在VBA中通过工具 - ＆gt; 引用... 添加对 Microsoft Scripting Runtime 的引用编辑菜单）：
Public Function GetFiles(ByVal roots As Variant) As Collection
Select Case TypeName(roots)
Case "String", "Folder"
roots = Array(roots)
End Select
Dim results As New Collection
Dim fso As New Scripting.FileSystemObject
Dim root As Variant
For Each root In roots
AddFilesFromFolder fso.GetFolder(root), results
Next
Set GetFiles = results
End Function
Private Sub AddFilesFromFolder(folder As Scripting.folder, results As Collection)
Dim file As Scripting.file
For Each file In folder.Files
results.Add file
Next
Dim subfolder As Scripting.folder
For Each subfolder In folder.SubFolders
AddFilesFromFolder subfolder, results
Next
End Sub
可以通过传入单个字符串（或GetFiles）来调用Folder函数：
Debug.Print GetFiles("c:\users\win8\documents").Count
或可以使用For Each迭代的任何内容 - 数组，集合，Dictionary，甚至是Excel Range对象：
Dim allFiles As Collection
Set allFiles = GetFiles(ws2.Range("A1:A" & Rows.Count).End(xlUp)) 'from question
GetFiles因为它适用于许多用例，并且不使用任何特定于Excel的对象。为了仅将结果限制为Excel文件，您可以创建新集合，并仅将Excel文件添加到新集合中：
'You could filter by the File object's Type property
Sub GetExcelFilesByType()
Dim allFiles As Collection
Set allFiles = GetFiles(ws2.Range("A1:A" & Rows.Count).End(xlUp)) 'from question
Dim excelFiles As New Collection
Dim file As Scripting.File
For Each file In allFiles
If file.Type = "Microsoft Excel Worksheet" Then excelFiles.Add file
Next
End Sub
' Or you could filter by extension, using the FileSystemObject.GetExtensionName method
Sub GetExcelFilesByExtensionName()
Dim allFiles As Collection
Set allFiles = GetFiles(ws2.Range("A1:A" & Rows.Count).End(xlUp)) 'from question
Dim excelFiles As New Collection
Dim fso As New Scripting.FileSystemObject
Dim file As Scripting.File
For Each file In allFiles
Select Case fso.GetExtensionName(file.path)
Case "xls", "xlsb", "xlsm"
excelFiles.Add file
End Select
Next
End Sub
要么从一组根文件夹中获取Collection个File个GetFiles个对象，只有Excel文件。
GetFiles）中，然后将非Excel文件过滤到新集合中。与仅将Excel文件添加到原始集合相比，此可能的性能较差，但这会将excelFiles限制为仅适用于此情况。excelFiles并将每个路径粘贴到工作表中。或者，您可以将Range转换为数组，并使用Excel Value对象的For Each属性设置数组中的所有值，而不使用{{1} }。