我正在为团队的文件共享整理一个文件夹树结构的重组方案。在实际进行任何操作之前，我想把计划中的移动、重命名、删除等列在Excel中。

为此，我希望在Excel工作表中有一个对文件夹树的表示。使用VBA，显然可以遍历文件系统并把条目写入工作表。然而，与其事先一次性读取整棵文件夹树，不如让它成为一个可交互的树，像文件资源管理器那样可以展开路径。

例子：当我有

C:
C:\Users
C:\Program Files
C:\Windows

在Excel表格中，选择 C:\Users 并启动一个VBA宏，我希望得到

C:
C:\Users
C:\Users\Default
C:\Users\MyUserId
C:\Users\Public
C:\Program Files
C:\Windows

我想当然，肯定有人手头已经有一个很实用的VBA脚本来实现这个功能……

解决方案

如果有人有这样的脚本，我找不到——所以在这里贴出我自己的解决方案：

' Column containing the paths
Const colPath As Integer = 1

Sub ExpandFolder()
    Dim r As Range, newRows As Range
    Set r = Selection.EntireRow.Cells(colPath)

    Dim fso As New FileSystemObject, childFolders As Scripting.Folders, f As Scripting.Folder
    Set childFolders = fso.GetFolder(r.Text).SubFolders
    If childFolders.Count = 0 Then Exit Sub

    ' Make space for the child entries
    r.EntireRow().Offset(1).Resize(childFolders.Count).Insert Shift:=xlDown
    Set newRows = r.EntireRow().Offset(1).Resize(childFolders.Count)
    r.EntireRow().Copy Destination:=newRows

    ' Insert paths
    For Each f In childFolders
        Set r = r.Cells(2, 1)
        r.Value = f.Path
    Next
    newRows.Sort newRows.Columns(1)
End Sub

当你定位到第一列包含文件夹路径的某一行并启动该宏时，该路径的子文件夹会插入到下面的行中。

此外，被“展开”行中的其他内容也会被复制。我用它来让文件夹树的可视化效果更好：

• 第一列，我存储完整路径。（这一列是隐藏的。）
• 第二列，我通过以下公式显示带缩进的文件夹名称（需要Excel 2024或 365）

=REPT(" ",LEN(A7)-LEN(SUBSTITUTE(A7,"\",""))-0) & TEXTAFTER(A7,"\",-1)

这样，上面的示例在我的Excel表格中将显示为：

C:
     Users
          Default
          MyUserId
          Public
     Program Files
     Windows