递归文件夹搜索将CSV组合到Master

时间:2017-09-11 16:56:34

标签: excel vba excel-vba csv recursion

我一直在使用它 - 但它不是递归的。如何将其作为递归文件搜索来将大约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

1 个答案:

答案 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