如何实现带层级编号的文件/文件夹递归列表导出至Excel？

我帮你梳理了原代码的问题所在，然后给出了一套优化后的解决方案，完全满足你需要的无限深度层级编号格式：

原代码的核心问题 #

你的代码没能生成正确层级编号的原因主要有几点：

• 递归过程中没有传递父层级的编号前缀，导致子文件夹/文件的编号无法继承父级序列
• 局部计数器在递归调用时会被重置，无法生成连贯的层级编号
• 重复遍历子文件夹，既浪费资源又容易导致编号混乱
• 输出列的逻辑和你需要的两列格式不匹配

优化后的完整VBA代码 #

Sub FolderNames()
    Application.ScreenUpdating = False
    Dim xPath As String
    Dim xWs As Worksheet
    Dim fso As Object
    Dim rowIndex As Long
    
    ' 让用户选择目标文件夹
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Choose the folder"
        If .Show <> -1 Then Exit Sub ' 用户取消选择则直接退出
        xPath = .SelectedItems(1) & "\"
    End With
    
    ' 初始化工作表
    Set xWs = ActiveSheet
    xWs.Cells.Clear ' 清空当前工作表（可根据需求注释掉）
    xWs.Cells(1, 1).Value = "Root Folder: " & xPath
    xWs.Cells(2, 1).Value = "Level"
    xWs.Cells(2, 2).Value = "Name"
    rowIndex = 3 ' 从第3行开始写入结构内容
    
    ' 创建文件系统对象
    Set fso = CreateObject("Scripting.FileSystemObject")
    ' 开始处理根文件夹，初始层级编号为"1"
    ProcessFolder fso.GetFolder(xPath), "1", rowIndex
    
    ' 美化表格（可选）
    xWs.Range("A2:B2").Font.Bold = True
    xWs.Columns("A:B").AutoFit
    
    Application.ScreenUpdating = True
    MsgBox "Folder structure exported successfully!", vbInformation
End Sub

Sub ProcessFolder(ByVal parentFolder As Object, ByVal currentLevel As String, ByRef rowIndex As Long)
    Dim subFolder As Object
    Dim file As Object
    Dim folderCounter As Integer
    Dim fileCounter As Integer
    
    ' 写入当前文件夹名称（根文件夹已在主过程标注，这里跳过根目录）
    If currentLevel <> "1" Then
        ActiveSheet.Cells(rowIndex, 1).Value = currentLevel
        ActiveSheet.Cells(rowIndex, 2).Value = parentFolder.Name
        rowIndex = rowIndex + 1
    End If
    
    ' 递归处理所有子文件夹
    folderCounter = 1
    For Each subFolder In parentFolder.SubFolders
        ' 生成子文件夹的层级编号：父层级 + "." + 子文件夹序号
        ProcessFolder subFolder, currentLevel & "." & folderCounter, rowIndex
        folderCounter = folderCounter + 1
    Next subFolder
    
    ' 处理当前文件夹下的所有文件
    fileCounter = 1
    For Each file In parentFolder.Files
        ActiveSheet.Cells(rowIndex, 1).Value = currentLevel & "." & fileCounter
        ActiveSheet.Cells(rowIndex, 2).Value = file.Name
        rowIndex = rowIndex + 1
        fileCounter = fileCounter + 1
    Next file
End Sub

代码关键说明 #

• 递归层级传递：核心的ProcessFolder子程序通过currentLevel参数传递当前的层级编号字符串，子文件夹的编号通过currentLevel & "." & folderCounter拼接生成，完美支持无限深度嵌套
• 行号引用传递：rowIndex通过引用传递，确保递归过程中行号连续递增，不会出现覆盖或空行
• 格式匹配：先处理子文件夹，再处理文件，完全符合你给出的示例格式
• 用户友好：加入了取消选择的判断、表格美化和成功提示，提升使用体验

使用方法 #

1. 打开Excel，按下Alt+F11打开VBA编辑器
2. 右键点击左侧的项目浏览器，选择「插入」→「模块」
3. 将上面的代码粘贴到模块中
4. 回到Excel界面，按下Alt+F8选择FolderNames宏并运行
5. 选择目标文件夹后，等待生成表格即可

内容的提问来源于stack exchange，提问作者InteressantPunt