包含文件的文件夹结构示例:
我希望将此结构转换为电子表格,如下所示:
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
最佳答案
我认为以下内容应该可行,它采用了您的一般概念,但对其进行了重组。我在 getSubFolder 中添加了另一个参数 prntLevel,它是一个以子文件夹或文件的索引为前缀的字符串。随着该过程在深入文件夹结构时通过自身递归回,它变成一个越来越长的数字序列。
此外,为了便于理解,每个子文件夹的索引为 0,以将其与 in 中包含的文件区分开来。否则,例如 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, 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
关于excel - 使用编号递归地列出文件和文件夹,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/48323055/