我一直在使用它 - 但它不是递归的。如何将其作为递归文件搜索来将大约100个.csv文件合并到一个工作簿中?
Sub test()
Dim myDir As String, fn As String, wb As Workbook
Set wb = ActiveWorkbook
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show Then myDir = .SelectedItems(1) & "\"
End With
If myDir = "" Then Exit Sub
fn = Dir(myDir & "*.csv")
Do While fn <> ""
With Workbooks.Open(myDir & fn)
.Sheets(1).Copy after:=wb.Sheets(wb.Sheets.Count)
.Close False
End With
fn = Dir
Loop
End Sub
答案 0 :(得分:1)
这是您可能想要的主要结构。取决于您是要处理第一个文件夹(选项1)还是仅处理子文件夹(选项2);选择放置代码的相应选项(替换Debug.Print Path & Folder
)
主要功能:
Sub MainListFolders()
ListFolders ("C:\Temp\")
End Sub
递归函数:
Sub ListFolders(Path As String)
Dim Folder As String
Dim FolderList() As String
Dim i As Long, Count As Long
Folder = Dir(Path, vbDirectory)
' Option 1: Can process folder here
'Debug.Print Path & sFolder
Do While Folder <> vbNullString
' Check that it is a Folder
If CBool(GetAttr(Path & Folder) And vbDirectory) Then
' We don't want to include the Current (".") or Previous ("..") folders, so..
If Replace(Folder, ".", vbNullString) <> vbNullString Then
' Option 2: Can process folder here
Debug.Print Path & Folder
' Store the list of Sub-Folders to recursively check at the end
' If you try to do a recursive call here, when it jumps back, it wont be able to process the next Dir()
' because the Dir() folder would have changed in the recurive call.
ReDim Preserve FolderList(Count)
FolderList(Count) = Folder
Count = Count + 1
End If
End If
Folder = Dir()
Loop
' Do the recursive calls here
For i = 0 To Count - 1
' Make sure to add the "\" to the end
ListFolders Path & FolderList(i) & "\"
Next
End Sub