Excel单元格扩展文件系统路径：将子文件夹写入下方单元格

以下是满足需求的VBA脚本，支持选中工作表中的文件夹路径后，在其下方插入该路径的一级子文件夹，同时保留原有其他路径条目：

Sub ExpandFolderTree()
    Dim selectedCell As Range
    Dim targetPath As String
    Dim fso As Object
    Dim parentFolder As Object
    Dim subFolder As Object
    Dim insertRow As Long
    Dim existingPaths As Collection
    Dim cell As Range
    Dim pathExists As Boolean
    
    ' 获取选中的单个单元格
    Set selectedCell = Selection
    If selectedCell.Cells.Count > 1 Then
        MsgBox "请仅选中单个包含文件夹路径的单元格", vbExclamation
        Exit Sub
    End If
    
    targetPath = Trim(selectedCell.Value)
    ' 验证路径是否为有效文件夹
    If Dir(targetPath, vbDirectory) = "" Then
        MsgBox "指定路径不是有效文件夹", vbExclamation
        Exit Sub
    End If
    
    ' 初始化FileSystemObject（后期绑定，无需额外引用）
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set parentFolder = fso.GetFolder(targetPath)
    insertRow = selectedCell.Row + 1
    
    ' 收集现有所有路径，避免重复添加
    Set existingPaths = New Collection
    On Error Resume Next
    For Each cell In ActiveSheet.UsedRange.Columns(selectedCell.Column).Cells
        If Trim(cell.Value) <> "" Then
            existingPaths.Add Trim(cell.Value), Key:=Trim(cell.Value)
        End If
    Next cell
    On Error GoTo 0
    
    ' 遍历子文件夹并插入到工作表中
    For Each subFolder In parentFolder.SubFolders
        pathExists = False
        On Error Resume Next
        existingPaths.Add subFolder.Path, Key:=subFolder.Path
        If Err.Number = 0 Then
            ' 路径不存在，插入行并写入路径
            ActiveSheet.Rows(insertRow).Insert Shift:=xlDown
            ActiveSheet.Cells(insertRow, selectedCell.Column).Value = subFolder.Path
            insertRow = insertRow + 1
        Else
            pathExists = True
        End If
        On Error GoTo 0
        
        If pathExists Then
            ' 可选：取消注释以下代码可提示已存在的路径
            ' MsgBox subFolder.Path & " 已存在于列表中", vbInformation
        End If
    Next subFolder
    
    ' 释放对象
    Set subFolder = Nothing
    Set parentFolder = Nothing
    Set fso = Nothing
    Set existingPaths = Nothing
    
    MsgBox "文件夹扩展完成", vbInformation
End Sub

关键功能说明： #

• 选中验证：仅允许选中单个单元格，避免批量操作错误
• 路径有效性检查：确保选中的内容是真实存在的文件夹路径
• 去重处理：自动跳过已存在于列表中的子文件夹路径
• 插入逻辑：在选中单元格的下一行插入子文件夹条目，不会覆盖原有其他路径
• 后期绑定：无需手动添加Microsoft Scripting Runtime引用，兼容性更强

使用步骤： #

1. 打开目标Excel文件，按下Alt + F11打开VBA编辑器
2. 右键点击项目列表，选择「插入」→「模块」
3. 将上述代码粘贴到新建模块中
4. 返回Excel工作表，选中包含目标文件夹路径的单元格（例如C:\Users）
5. 按下Alt + F8，选择ExpandFolderTree宏并执行

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