VBA常用小代码

04 其他

获取文件夹内的所有文件名称(含子-孙文件)、认识递归函数

  在 Excel VBA 中，递归是指在函数内部再次调用自身的一种方法。它常用于解决"可分解为相似子问题的问题"（如遍历文件夹结构、计算阶乘等）。

  递归编程的一个优点是程序代码变得更短、更优雅。此外，在某些情况下，递归调用是对其进行编程的唯一方法。

  比如本章的示例，获取文件夹内的所有文件、包含子文夹内、孙文件夹内......，这是一个典型的树形结构，主干、枝干、细分枝干、在细分.....。

  事先你并不知道文件夹内有多少个子孙文件夹的嵌套，也并不清楚一个文件夹内有多少个子文件夹的存在，就不能确定需要循环和嵌套循环的次数，所以调用递归函数来解决这个问题就变成了最优解！

本节关于递归函数过程和说明释义：
函数过程：
复制成功!
1

Sub 递归函数(路径 as string)

    If 路径下有文件  Then
       输出文件名称
    End IF

    If 路径下有文件夹 Then
       输出文件夹名称(可选)
       获取子文件夹的路径
       Call 递归函数(新文件夹路径)       '调用自身
    End If
End Sub
释义说明：
点击放大的图片
文件夹嵌套：
点击放大的图片

运行视频：

源码下载：

描述：

  获取某个文件夹下的所有文件名，包括所有子文件夹、孙文件夹......

样本示例："豆包"安装路径下的文件
点击放大的图片
需求分析：
  • 1、获取某个文件夹下的所有文件名称(含子、孙文件)；
  • 2、被获取的"根文件夹"可选择；
  • 3、"文件名"和"文件夹名"读取到新的Excel表格，并标记是文件或文件夹；
  • 4、为方便查看文件夹下的嵌套文件的结构，对"文件夹名"增加底色，相同路径下的文件放置到一起。
VBA实现过程：
  • 1.把"可选择根文件夹"、"新建表格保存读取"、"增加底色、放置一起"等这些操作，放置到主程序中；
  • 2.单独写一个递归函数(获取文件名称的实现过程)的子程序，参数包含路径、目标的工作表和起始行位置。在主程序中调用它；
  • 3.主程序中的几个功能实现：
  • ①Application.FileDialog(msoFileDialogFolderPicker)，一个Application对象，用于在VBA中显示一个文件夹选择对话框，允许用户从文件系统中选择一个文件夹；
  • ②ThisWorkbook.Sheets.Add，一个工作表方法，增加一个新的工作表，在示例中的命名是：文件列表 + 时间
  • ③ActiveWindow.FreezePanes = True，冻结读取表的首行；
  • ④.Interior.Color增加底色，这里用了一个内置方法.CurrentRegion.AutoFilter，设置数据筛选的属性，把所有"文件夹"的行筛选出来之后、增加底色；
  • ⑤.Sort内置方法，对于相同路径的文件放置在一块，因为输出的文件和文件夹名称包含完整路径，排序即可实现，.Sort内置方法用来排序，key1增加排序条件列，Order1是升降序条件。
  • 4.递归函数的注意事项：
  • ①Dir(参数)函数：查找某个路径下文件或文件夹的方法，配合Do While...Loop循环，vbNormal参数表示文件，vbDirectory表示文件夹
  • ②注意，因为一个文件夹中可能存在多个子文件夹，我们必须要把所有的子-孙文件夹的路径全部获取到，不遗漏任何文件夹。这里我们用一个Collection 集合，保存获取到的所有子文件夹的绝对路径，然后循环集合内的每个元素，获取该路径下的文件。这个非常重要。
  • ③鉴于以上问题，我们可以把递归函数的过程分成三个实现不同功能的过程：
  •   a.获取文件名称；
  •   b.获取文件夹路径保存到集合；
  •   c.对集合元素遍历，调用递归函数，重复执行①和②，直到穷尽！
示例代码
复制成功!
1

Sub 获取指定文件夹内的所有文件()
    Dim File_path_base As String
    Dim Sheet_New As Worksheet
    Dim Row_Count As Long

    ' 使用文件夹选择对话框，指定文件夹路径
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "请选择要遍历的文件夹"
        .AllowMultiSelect = False                         '设置为 False ,表示文件对话框只允选择单个文件
        If .Show = -1 Then                                '弹窗一个文件夹选择框
            File_path_base = .SelectedItems(1) & "\"      '获取指定的文件夹路径
        Else
            Exit Sub
        End If
    End With

    ' 设置输出位置（新建工作表，用当前日期"年月日时分秒"命名）
    Set Sheet_New = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
    Sheet_New.Name = "文件列表_" & Format(Now, "yyyymmdd_hhmmss")

    Row_Count = 1                                         ' 初始化行计数器，从第一行开始
    Sheet_New.Cells(Row_Count, 1) = File_path_base               ' 添加根文件夹
    Sheet_New.Cells(Row_Count, 2) = "根目录"                     ' 添加根文件夹
    Row_Count = Row_Count + 1

    '调用递归函数
    Call TraverseFolder(File_path_base, Sheet_New, Row_Count)    ' 调用递归函数

    '整理获取文件夹及文件，按照根目录――根目录文件――子文件夹――子文件――孙文件夹――孙文件排序
    With Sheet_New
        .Rows("2:2").Select
        ActiveWindow.FreezePanes = True                   '冻结首行(标题行)
    End With
    '排序
    With Sheet_New.Range("A1").CurrentRegion                     '对工作表当前区域升序排序,包含标题行
        .Sort key1:=.Range("A1"), Order1:=xlAscending, Header:=xlYes
    End With
    '"文件夹"增加底色
    Sheet_New.Range("A1").CurrentRegion.AutoFilter Field:=2, Criteria1:="文件夹"  '筛选，第二列中包含"文件夹"的行
    With Sheet_New.Range("A1").CurrentRegion
        .Interior.Color = RGB(180, 180, 180)                              '增加底色
        .Font.Bold = True                                                 '字体加粗
        .AutoFilter                                                       '取消筛选
    End With
    Sheet_New.Columns("A:A").EntireColumn.AutoFit                                '自动调整列宽

End Sub

' 递归函数
Sub TraverseFolder(File_Path As String, Sheet_New As Worksheet, ByRef rowNum As Long)
    Dim File_Name As String
    Dim File_Name_son As String
    Dim Full_Path As String
    Dim Files_Col As Collection

    Set Files_Col = New Collection                           ' 创建集合，存储子文件夹
'----------------------------------------------------------------------------------------
    ' 步骤1: 获取当前文件夹下的所有文件
    File_Name = Dir(File_Path & "*", vbNormal)               'vbNormal类型，单指文件
    Do While File_Name <> ""
        If File_Name <> "." And File_Name <> ".." Then       '跳过系统目录
            Full_Path = File_Path & File_Name
            If (GetAttr(Full_Path) And vbDirectory) = 0 Then ' 确保是文件
                Sheet_New.Cells(rowNum, 1) = Full_Path              '写入文件名
                Sheet_New.Cells(rowNum, 2) = "文件"                  '写入文件类型
                rowNum = rowNum + 1
            End If
        End If
        File_Name = Dir()                                     '查找其他文件
    Loop

'----------------------------------------------------------------------------------------
    ' 步骤2: 获取所有子文件夹并存储到集合
    File_Name_son = Dir(File_Path, vbDirectory)                 'vbDirectory，单指文件夹
    Do While File_Name_son <> ""
        If File_Name_son <> "." And File_Name_son <> ".." Then  '跳过系统目录
            Full_Path = File_Path & File_Name_son
            If (GetAttr(Full_Path) And vbDirectory) = vbDirectory Then
                Files_Col.Add Full_Path & "\"                    ' 如果是子文件夹，先添加到集合中存储
                Sheet_New.Cells(rowNum, 1) = Full_Path & "\"             '写入文件夹名称
                Sheet_New.Cells(rowNum, 2) = "文件夹"                     '写入文件类型

                rowNum = rowNum + 1
            End If
        End If
        File_Name_son = Dir()                                   '查找其他文件夹
    Loop

'----------------------------------------------------------------------------------------
    ' 步骤3: 递归处理所有子文件夹
    Dim i As Long
    For i = 1 To Files_Col.Count
        Call TraverseFolder(Files_Col(i), Sheet_New, rowNum)          '调用递归处理
    Next i

    Set Files_Col = Nothing                                     ' 清理集合
End Sub

基础知识点：

请开发者喝杯咖啡 请开发者喝杯咖啡！