递归获取指定文件夹下全部文件的路径

Dim jg(), k&, tms#, n '因为是递归，所以事先指定存放结果的公用变量数组jg以及计数器k和起始时间tms
Dim ar_res(1 To 65535, 1 To 10)
Dim k_res As Long
Dim dic_cust_yu_e_last As Object
Dim str_save_as_path As String
Sub main()
    Call m_forEachMultiSubFolder.getCustomerNameAndLastYuEByFullPathOverrideForLastYuEValidation
    getSaveAsPath '结果保存路径
    Call mergerMultiSheetByPath
End Sub

Sub getSaveAsPath()
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "请选择结果保存路径......"
        .InitialFileName = "C:\Users\Administrator\Desktop\批量改名测试\"
        If .Show Then myPath$ = .SelectedItems(1) Else End
    End With
    str_save_as_path = myPath
End Sub
Function getCustomerNameAndLastYuEByFullPathOverrideForLastYuEValidation() '余额验证  选择上期对账单路径
    Set dic_cust_yu_e_last = CreateObject("scripting.dictionary")
    sb& = 0
    SpFile$ = ".xl"
    If SpFile Like ".*" Then SpFile = LCase(SpFile) & "*" '如果指定了文件类型则一律转换为大写字母方便比较
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "请选择数据源路径......"
        .InitialFileName = "C:\Users\Administrator\Desktop\批量改名测试\"
        If .Show Then myPath$ = .SelectedItems(1) Else End
    End With
    If Right(myPath, 1) <> "" Then myPath = myPath & ""
    ReDim jg(65535, 3)
    jg(0, 0) = "Ext": jg(0, 1) = IIf(sb < 0, IIf(Len(SpFile), "Filename", "No"), "Filename")
    jg(0, 2) = "Folder": jg(0, 3) = "Path"
    '定义存放文件名结果的数组jg 、并写入标题
    tms = Timer: k = 0: Call ListAllFso002(myPath, sb, SpFile) '调用递归过程检查指定文件夹及其子文件夹
    If sb < 0 And Len(SpFile) = 0 Then Application.StatusBar = "Get " & k & " Folders."
    [a1].CurrentRegion = ""
    [a1].Resize(k + 1, 4) = jg
    [a1].CurrentRegion.AutoFilter Field:=1
    '输出结果到工作表，并启用筛选模式
    getCustomerNameAndLastYuEByFullPathOverrideForLastYuEValidation = jg
End Function

Sub mergerMultiSheetByPath()
    For x = 1 To UBound(jg)
        If Len(jg(x, 3)) > 0 Then
            str_name_customer = Mid(jg(x, 1), 2, 99)
            cur_path = jg(x, 3) & "\" & Mid(jg(x, 1), 2, 99) & jg(x, 0)
            name_department = jg(x, 2)
            Call getListFilesByCurPath(cur_path, str_name_customer)
        End If
    Next
End Sub
''如果需要操作文件以及文件内的各个工作表Sheet，那么当然首先要打开该文件。
Function getListFilesByCurPath(myPath, nameCust)
    On Error Resume Next
    Application.ScreenUpdating = False
    If Not isEmpty(myPath) And InStr(myPath, "xl") Then
        Set wb726 = Workbooks.Open(myPath) '打开文件
        For Each Sh In wb726.Sheets '遍历该文件的所有工作表
            If InStr(Sh.Name, "往来对账") Then
                Sh.Activate '激活工作表
                With Sheets(Sh.Name)
                    name_customer = .[b2]
                    wbname = wb726.Name
                    If name_customer <> wbname And wbname <> ThisWorkbook.Name Then
                        'wb726.SaveAs Filename:=ThisWorkbook.Path & "\" & name_customer & ".xls"
                        
                        wb726.SaveAs Filename:=str_save_as_path & "\" & name_customer & ".xls"
                        
                        wb726.Close '关闭文件
                    End If
                End With
            End If
        Next
    End If
    Application.ScreenUpdating = True
End Function

Function ListAllFso002(myPath$, Optional sb& = 0, Optional SpFile$ = "") '递归检查子文件夹的过程代码
    Set fld = CreateObject("Scripting.FileSystemObject").GetFolder(myPath)
    On Error Resume Next
    If sb >= 0 Or Len(SpFile) Then '如果模式为0或1、或指定了匹配文件要求，则遍历各个文件
        For Each f In fld.files '用FSO方法遍历文件.Files
            t = False '匹配状态初始化
            n = InStrRev(f.Name, "."): fnm = Left(f.Name, n - 1): x = LCase(Mid(f.Name, n))
            If Err.Number Then Err.Clear
            
            If SpFile = " " Then 'Space 如果匹配要求为空则匹配全部
                t = True
            ElseIf SpFile Like ".*" Then '如果匹配要求为文件类型则
                If x Like SpFile Then t = True '当文件符合文件类型要求时匹配，否则不匹配
            Else '否则为需要匹配文件名称中的一部分
                If InStr(fnm, SpFile) Then t = True '如果匹配则状态为True
            End If
            If t Then k = k + 1: jg(k, 0) = x: jg(k, 1) = "'" & fnm: jg(k, 2) = fld.Name: jg(k, 3) = fld.Path
        Next
        Application.StatusBar = Format(Timer - tms, "0.0s") & " Get " & k & " Files , Searching in Folder ... " & fld.Path
    End If
    For Each fd In fld.SubFolders '然后遍历检查所有子文件夹.SubFolders
        If sb < 0 And Len(SpFile) = 0 Then k = k + 1: jg(k, 0) = "fld": jg(k, 1) = k: jg(k, 2) = fd.Name: jg(k, 3) = fld.Path
        If sb Mod 2 = 0 Then Call ListAllFso002(fd.Path, sb, SpFile)
    Next
End Function




'