使用编号递归地列出文件和文件夹

Question

包含文件的文件夹结构示例：

• 文件夹 1
  • 子文件夹 1
    • 文件 1
    • 文件 2
  • 子文件夹 2
    • 文件 3
• 文件夹 2
  • 文件 4

我希望将此结构转换为电子表格，如下所示：

column 1 column 2 1 folder 1 1.1 subfolder 1 1.1.1 file 1 1.1.2 file 2 1.2 subfolder 1 1.2.1 file 3 2 folder 2 2.1 file 4

我怎样才能做到最好？我试过 VBA 宏。我确实设法列出了所有文件和文件夹。但是编号不成功。请注意，子文件夹的深度不限于此示例。理论上，编号可以比 1.1.1.1.1.1.1.1.1 等更远。

Sub FolderNames()
Application.ScreenUpdating = False
Dim xPath As String
Dim xWs As Worksheet
Dim fso As Object, j As Long, folder1 As Object
With Application.FileDialog(msoFileDialogFolderPicker)
    .Title = "Choose the folder"
    .Show
End With
On Error Resume Next
xPath = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1) & "\"
'Application.Workbooks.Add
Set xWs = Application.ActiveSheet
xWs.Cells(1, 1).Value = xPath
xWs.Cells(2, 1).Resize(1, 2).Value = Array("Level", "Name")
Set fso = CreateObject("Scripting.FileSystemObject")
Set folder1 = fso.getFolder(xPath)
getSubFolder folder1
Application.ScreenUpdating = True
End Sub


Sub getSubFolder(ByRef prntfld As Object)
Dim xFolderName As String
Dim xFileSystemObject As Object
Dim xFolder As Object
Dim xSubFolder As Object
Dim xFile As Object
Dim rowIndex As Long
Dim filecounter As Integer
Dim foldercounter As Integer
Dim SubFolder As Object
Dim subfld As Object
Dim xRow As Long
foldercounter = 1

For Each SubFolder In prntfld.SubFolders
subcount = subcount + 1
    filecounter = 1
    xFolderName = SubFolder.Path
    Set xFileSystemObject = CreateObject("Scripting.FileSystemObject")
    Set xFolder = xFileSystemObject.getFolder(xFolderName)
    xRow = Range("A1").End(xlDown).Row + 1

    Cells(xRow, 1).Resize(1, 3).Value = Array(foldercounter, filecounter, SubFolder.Name)

    For Each xFile In xFolder.Files
        xRow = Range("A1").End(xlDown).Row + 1
        Cells(xRow, 1).Resize(1, 3).Value = Array(foldercounter, filecounter, xFile.Name)
        filecounter = filecounter + 1
    Next xFile

    foldercounter = foldercounter + 1
Next SubFolder

For Each subfld In prntfld.SubFolders
    getSubFolder subfld
Next subfld

End Sub

Answer 1

我认为以下内容应该可行，它采用了您的一般概念，但对其进行了重组。我在 getSubFolder 中添加了另一个参数 prntLevel，它是一个以子文件夹或文件的索引为前缀的字符串。随着过程在深入到文件夹结构中循环返回，它变成了一个越来越长的数字序列。

另外，为了便于理解，每个子文件夹的索引为 0，以将其与包含在 in 中的文件区分开来。否则，例如 1.1 可以是第一个文件，也可以是第一个在 in 中开始变得不明显的子文件夹随着你的树越来越深，我的看法。

Sub FolderNames()
    Application.ScreenUpdating = False
    Dim xPath As String
    Dim xWs As Worksheet
    Dim fso As Object, j As Long, folder1 As Object
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Choose the folder"
        .Show
    End With
    On Error Resume Next
    xPath = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1) & "\"
    'Application.Workbooks.Add
    Set xWs = Application.ActiveSheet
    xWs.Cells(1, 1).Value = xPath
    xWs.Cells(2, 1).Resize(1, 2).Value = Array("Level", "Name")
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set folder1 = fso.getFolder(xPath)
    getSubFolder folder1, ""
    Application.ScreenUpdating = True
End Sub


Sub getSubFolder(ByRef prntfld As Object, prntLevel As String)
    Dim xFolderName As String
    Dim xFileSystemObject As Object
    Dim xFolder As Object
    Dim xSubFolder As Object
    Dim xFile As Object
    Dim rowIndex As Long
    Dim filecounter As Integer
    Dim foldercounter As Integer
    Dim SubFolder As Object
    Dim subfld As Object
    Dim xRow As Long
    foldercounter = 1
    For Each SubFolder In prntfld.SubFolders
        subcount = subcount + 1
        filecounter = 0
        xFolderName = SubFolder.Path
        Set xFileSystemObject = CreateObject("Scripting.FileSystemObject")
        Set xFolder = xFileSystemObject.getFolder(xFolderName)
        xRow = Range("A1").End(xlDown).Row + 1
        Cells(xRow, 1).Resize(1, 2).Value = Array(prntLevel & foldercounter & "." & filecounter, SubFolder.Name)
        getSubFolder SubFolder, prntLevel & foldercounter & "."
        For Each xFile In xFolder.Files
            filecounter = filecounter + 1
            xRow = Range("A1").End(xlDown).Row + 1
            Cells(xRow, 1).Resize(1, 2).Value = Array(prntLevel & foldercounter & "." & filecounter, xFile.Name)
        Next xFile
        foldercounter = foldercounter + 1
    Next SubFolder
End Sub