ExcelVBA文件操作-获取文件夹（含子文件夹）所有文件列表（优化版）

哆哆Excel

发布于 2023-09-09 10:47:36

1.5K0

发布于 2023-09-09 10:47:36

文章被收录于专栏：哆哆Excel

1.ExcelVBA文件操作-选择文件夹（含子文件夹）获取所有文件列表

2.ExcelVBA文件操作-选择文件夹获取文件列表

3.ExcelVBA文件操作-获得文件夹中的所有子文件夹

4.ExcelVBA-打开对话框取得文件夹路径2种方法

【问题】

前面的学习中，有几个自定义函数：1.运行不是那么优化，2.在实际应用中我们关注的是文件路径，对文件夹的路径不是那么关注今天进行优化：取自定义函数为：arr=GetAllFolderFiles(路径，参数）只获取文件的路径，添加了可选项，参数默认为0时，只读取本目录的文件列表，参数不等于0时，读取本目录（含子目录）的所有文件列表

【两个自定义函数】

    '打开对话框，选择，取得文件夹路径，返回string
Function SelectGetFolder()
    '选择单一文件
    With Application.FileDialog(msoFileDialogFolderPicker)
        .InitialFileName = ThisWorkbook.Path
        If .Show = -1 Then
            'FileDialog 对象的 Show 方法显示对话框，并且返回 -1（如果您按 OK）和 0（如果您按 Cancel）。
            '            MsgBox "您选择的文件夹是：" & .SelectedItems(1)
            SelectGetFolder = .SelectedItems(1)
        Else
            SelectGetFolder = ""
        End If
    End With
End Function

arr=GetAllFolderFiles(路径，参数）

    '输入文件夹，返回数组=文件夹包含子文件夹列表
    ' 用法：arr=GetAllFolderFiles(路径，2）参数Ndir=1不包含子目录，Ndir>1包含子目录
Function GetAllFolderFiles(sPath As Variant, Optional Ndir As Long = 0)
    Dim sDic As Object, sFso As Object, sFld As Object, sFiles As Object, F As Object
    Dim n As Long, k As Long
    Dim sf As Object, sk As Variant
    Dim sResArr(), stempArr
    '    On Error Resume Next
    Set sDic = CreateObject("Scripting.Dictionary")
    Set sFso = CreateObject("Scripting.FileSystemObject")
    sDic(sPath) = ""
    If Ndir <> 0 Then
        Do
            stempArr = sDic.keys
            For Each F In sFso.GetFolder(stempArr(n)).SubFolders
                sDic(F.Path) = ""
            Next
            n = n + 1
        Loop Until sDic.Count = n
    End If
    ReDim sResArr(1 To 1)
    For Each sk In sDic.keys
        Set sFld = sFso.GetFolder(sk)
        Set sFiles = sFld.Files
        For Each sf In sFiles
            k = k + 1
            If k > UBound(sResArr) Then ReDim Preserve sResArr(1 To k)
            sResArr(k) = sf
        Next
    Next
    GetAllFolderFiles = sResArr
    Set sDic = Nothing
    Set sFso = Nothing
End Function

【效果】