VBA：文件夹路径列表，返回excel文件路径列表，然后编辑excel

Question

我有一个用户窗体，它将文件夹路径粘贴到列表中。 然后，我得到下面的代码，该代码应该遍历该列表并列出所有子文件夹（然后，我可能会通过子文件夹进行另一个代码遍历以获得excel工作簿）。

我知道这很不雅致，因为最终我想要的是一次查看我的路径列表，通过每个文件夹和子文件夹查找并列出excel文件。 但是有这样一个问题 ，它被删除了。 然后将问题转给我不理解的另一个问与答，这与单个文件名有关，在单个单元格中而不是范围或路径中键入。 我说俄语，他的一些代码在其中，但仍然不太明白他的代码的含义和所指的含义，当我尝试使用它时，它总是告诉我们“ GetData”未定义？ 因此，我尝试提出了一个不同但相似的问题，希望有人可以向我解释我需要做的事情，因为我已经尽我所能，并尝试通过本文中的链接修改两种代码以及许多其他 我有几个模块的代码残破不起作用，而我最近找到的模块是下面的代码。 在这一点上，我只想解决从路径列表中列出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步。我上周在此处发布了更详细的解释，但到目前为止以获得任何反馈或潜在的提示。

如果这没有道理或半危险，我深表歉意。 我是在excel VBA中自学的，正在努力了解我所需要的甚至是可能的。 我尝试使用Directory，但将目录放入每个循环的成功很少。 我还尝试使用一个数组，由于该数组列出了整个计算机中的所有文件夹和文件，因此几乎崩溃了。

Answer 1

这是一种快速方法， 对此答案略有改动。

只需将您的文件夹位置添加到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

Answer 2

如果我理解正确，那么您的要求如下：

• 从一组根路径开始
• 递归遍历每个根路径中的所有文件
• 对于结果集合中的每个文件（如果是Excel文件），请添加到最终列表中以进行进一步处理

让我们从前两点开始。 我建议使用以下代码（确保通过VBA编辑器菜单中的“ 工具” ->“ 引用...”添加对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

可以通过传入单个字符串（或Folder ）来调用GetFiles函数：

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对象，只是Excel文件中，从根集文件夹。

---

笔记

• 这段代码将所有文件（不仅是Excel文件）递归地添加到一个集合中（在GetFiles ），然后将非Excel文件过滤GetFiles一个新集合中。 与仅将Excel文件添加到原始集合中相比，这可能会降低性能，但这将GetFiles限制为仅在这种情况下。
• 如果要将结果粘贴到Excel工作表中，可以遍历excelFiles并将每个路径粘贴到工作表中。 或者，您可以将excelFiles转换为数组，然后使用Excel Range对象的Value属性设置数组中的所有值，而无需使用For Each 。

---

参考

Microsoft脚本运行时

• FileSystemObject对象 ， GetExtensionName方法
• 文件对象
• 文件夹对象

VBA

• 收集对象