Vba 尝试在子文件夹和子文件夹中的文件之间循环
我想使用VBA访问一个文件夹,并循环浏览所有子文件夹中的所有Excel文件。更具体地说,我希望从每个文件中的特定单元格收集数据,并将数据转储到活动工作簿中。我觉得写起来应该很容易,但到目前为止我一直不成功。我尝试了几种方法来循环浏览我在网上找到的子文件夹,但都没有用 以下是我想要实现的视觉效果:Vba 尝试在子文件夹和子文件夹中的文件之间循环,vba,excel,loops,directory,Vba,Excel,Loops,Directory,我想使用VBA访问一个文件夹,并循环浏览所有子文件夹中的所有Excel文件。更具体地说,我希望从每个文件中的特定单元格收集数据,并将数据转储到活动工作簿中。我觉得写起来应该很容易,但到目前为止我一直不成功。我尝试了几种方法来循环浏览我在网上找到的子文件夹,但都没有用 以下是我想要实现的视觉效果: Sub example() 'Find a way to enter file path 'Find a way to loop through subfolders 'Find a way to lo
Sub example()
'Find a way to enter file path
'Find a way to loop through subfolders
'Find a way to loop through excel files and refer to current file below
x = 2
Workbooks(Loop Test.xlsm).Worksheets("Sheet1").Cells(x,1) = 'current file in loop range A1
Workbooks(Loop Test.xlsm).Worksheets("Sheet1").Cells(x,2) = 'current file in loop range A2
' etc.
x = x + 1
' next file
End Sub
我想我明白了:
Sub Test2()
Dim wb As Workbook, ws As Worksheet
Set fso = CreateObject("Scripting.FileSystemObject")
Set fldr = fso.GetFolder("C:\Users\azrae\OneDrive\Desktop\To Be Transferred\Optimum\Test Folder\")
x = 2
For Each sfldr In fldr.SubFolders
For Each wbfile In sfldr.Files
If fso.getextensionname(wbfile.Name) = "xlsx" Then
Set wb = Workbooks.Open(wbfile.Path)
End If
Workbooks("Loop Test.xlsm").Worksheets("Sheet1").Cells(x, 1) = wb.Worksheets("Sheet1").Range("A1")
Workbooks("Loop Test.xlsm").Worksheets("Sheet1").Cells(x, 2) = wb.Worksheets("Sheet1").Range("A2")
Workbooks("Loop Test.xlsm").Worksheets("Sheet1").Cells(x, 3) = wb.Worksheets("Sheet1").Range("A3")
wb.Close
x = x + 1
Next wbfile
Next sfldr
End Sub
如果您有更平滑的方法,请告诉我。编写函数返回文件列表将使测试更容易 试验 getFileList:函数
只要只有一个级别的子文件夹,这将起作用。您将需要一个递归函数来遍历深度嵌套的文件夹结构。
Sub TestGetFileList()
Dim f As Variant, fileList As Object
Set fileList = getFileList("C:\Level 1")
For Each f In fileList
Debug.Print f
Next
End Sub
Function getFileList(Path As String, Optional FileFilter As String = "*.xls?", Optional fso As Object, Optional list As Object) As Object
Dim BaseFolder As Object, f As Object
If fso Is Nothing Then
Set fso = CreateObject("Scripting.FileSystemObject")
Set list = CreateObject("System.Collections.ArrayList")
'Set list = CreateObject("Scripting.Dictionary")
End If
If Not Right(Path, 1) = "\" Then Path = Path & "\"
If Len(Dir(Path, vbDirectory)) = 0 Then
MsgBox Path & " not found"
Exit Function
End If
Set BaseFolder = fso.GetFolder(Path)
For Each f In BaseFolder.SubFolders
getFileList f.Path, FileFilter, fso, list
Next
For Each f In BaseFolder.files
If f.Path Like FileFilter Then list.Add f.Path
Next
Set getFileList = list
End Function