Question

我已经使用Cor_blimey的队列方法将驱动器的所有文件夹和子文件夹写入Excel工作表，如下所示：

Public Sub NonRecursiveMethod()
    Dim fso, oFolder, oSubfolder, oFile, queue As Collection

    Set fso = CreateObject("Scripting.FileSystemObject")
    Set queue = New Collection
    queue.Add fso.GetFolder("your folder path variable") 'obviously replace

    Do While queue.Count > 0
        Set oFolder = queue(queue.count)
        queue.Remove(queue.count) 'dequeue
        '...insert any folder processing code here...'
       '*...(Here I write the name of the folder to the excel sheet)*.
        For Each oSubfolder In oFolder.SubFolders
            queue.Add oSubfolder 'enqueue
        Next oSubfolder
        For Each oFile In oFolder.Files
       '...insert any file processing code here...
       Next oFile
    Loop

End Sub

我已经尝试了＆＃34; LIFO＆＃34;版本（如上所述）和＆＃34; FIFO＆＃34;版本，但它们都没有产生标准的字母顺序列表。上面的版本按照完全相反的字母顺序列出了驱动器，并且＆＃34; FIFO＆＃34; version按正常的字母顺序生成一个列表，但它只列出第一级文件夹，然后再次启动并按字母顺序列出所有二级文件夹，再按第三级文件夹列出，再次从＆＃34开始; A＆＃34;等等。因此，子文件夹未列在其父文件夹下。

有没有人知道我可以做些什么来获得标准树结构，按字母顺序按文件夹和子文件夹名称？

TIA

莱斯

更新：出于某种原因，我无法在此主题上显示所有评论或撰写新评论。但是我要感谢所有人，特别是@Rosenfeld，并说我渴望使用dir来尝试解决方案，但我目前正忙于工作。当我有机会偶然发现时，我会在几天内报告。

Answer 1

我知道你使用的是非递归方法，但不可否认的是，我想尝试使用递归来解决任务（特别是对于将来可能需要它的人）。

注意：我不确定Scripting.FileSystem文件夹/文件集合是否总是按字母顺序排列，因此我假设它们属于这种情况，但我可能错误。

从简短的测试中我没有注意到递归的任何性能问题，但根据目录大小，肯定会有一个。

最后，main函数中的'CleanOutput'参数用于确定层次关系是否显示在输出中。

用于测试/输出的方法

Sub Test()
    Dim fso As Scripting.FileSystemObject
    Set fso = New Scripting.FileSystemObject

    Dim Folder As Scripting.Folder
    Set Folder = fso.GetFolder("C:")

    Dim Test As Variant
    Test = GetDirectoryFromScriptingFolder(Folder, True)

    ActiveSheet.Range("A1").Resize(UBound(Test, 1), UBound(Test, 2)).value = Test
End Sub

主要功能

Private Function GetDirectoryFromScriptingFolder(ByVal InputFolder As Scripting.Folder, Optional CleanOutput As Boolean = False) As Variant
    ' Uses recursion to return an organized hierarchy that represents files/folders in the input directory
    Dim CurrentRow As Long
    CurrentRow = 1

    Dim CurrentColumn As Long
    CurrentColumn = 1

    Dim OutputDirectory As Variant
    ReDim OutputDirectory(1 To GetDirectoryLength(InputFolder), 1 To GetDirectoryDepth(InputFolder))

    WriteFolderHierarchy InputFolder, OutputDirectory, CurrentRow, CurrentColumn, CleanOutput

    ' Adjust current column so that files in the parent directory are properly indented
    WriteFileHierarchy InputFolder, OutputDirectory, CurrentRow, CurrentColumn + 1, CleanOutput

    GetDirectoryFromScriptingFolder = OutputDirectory
End Function

递归中使用的函数

Private Sub WriteFolderHierarchy(ByVal InputFolder As Scripting.Folder, ByRef InputHierarchy As Variant, ByRef CurrentRow As Long, ByVal CurrentColumn As Long, ByVal CleanOutput As Boolean)
    If Not IsArray(InputHierarchy) Then Exit Sub

    InputHierarchy(CurrentRow, CurrentColumn) = InputFolder.Name
    CurrentRow = CurrentRow + 1

    Dim StartRow As Long
    Dim SubFolder As Folder
    For Each SubFolder In InputFolder.SubFolders
        ' Use recursion to write the files/folders of each subfolder to the directory
        StartRow = CurrentRow
        WriteFolderHierarchy SubFolder, InputHierarchy, CurrentRow, CurrentColumn + 1, CleanOutput
        WriteFileHierarchy SubFolder, InputHierarchy, CurrentRow, CurrentColumn + 2, CleanOutput

        If CleanOutput Then
            For StartRow = StartRow To CurrentRow
                InputHierarchy(StartRow, CurrentColumn) = "||"
            Next
        End If
    Next
End Sub

Private Sub WriteFileHierarchy(ByVal InputFolder As Scripting.Folder, ByRef InputHierarchy As Variant, ByRef CurrentRow As Long, ByVal CurrentColumn As Long, ByVal CleanOutput As Boolean)
    If Not IsArray(InputHierarchy) Then Exit Sub

    Dim SubFile As File
    For Each SubFile In InputFolder.Files
        ' Write the Files to the Hierarchy
        InputHierarchy(CurrentRow, CurrentColumn) = SubFile.Name
        If CleanOutput Then InputHierarchy(CurrentRow, CurrentColumn - 1) = "--"
        CurrentRow = CurrentRow + 1
    Next
End Sub

辅助函数（深度和长度）

Private Function GetDirectoryLength(ByVal InputFolder As Scripting.Folder) As Long
    Dim TotalLength As Long

    ' Include a base of 1 to account for the input folder
    TotalLength = 1 + InputFolder.Files.Count

    Dim SubFolder As Scripting.Folder
    For Each SubFolder In InputFolder.SubFolders
        ' Add 1 to the total to account for the subfolder.
        TotalLength = TotalLength + GetDirectoryLength(SubFolder)
    Next

    GetDirectoryLength = TotalLength
End Function

Private Function GetDirectoryDepth(ByVal InputFolder As Scripting.Folder) As Long
    Dim TotalDepth As Long

    Dim SubFolder As Scripting.Folder
    Dim MaxDepth As Long
    Dim NewDepth As Long
    For Each SubFolder In InputFolder.SubFolders
        NewDepth = GetDirectoryDepth(SubFolder)

        If NewDepth > MaxDepth Then
            MaxDepth = NewDepth
        End If
    Next

    If MaxDepth = 0 Then MaxDepth = 1

    ' Add 1 for the Parent Directory
    GetDirectoryDepth = MaxDepth + 2
End Function

实质上是这样的：

我们采用输入文件夹并确定层次结构的维度该文件
接下来，我们使用这些维度定义输出数组。
使用行计数器和列计数器，我们允许递归函数将递归结果直接写入层次结构
返回此层次结构，主例程将此直接放入工作表

您可以采取的后续步骤

我注意到了一些这样做的事情

除了文件名之外，没有其他信息，具体取决于应用程序，可能会使方法无用
包含所有文件在输出中，不仅仅是重要的（非重要文件）临时，隐藏等。）
即使使用CleanOutput选项，也没有简单的方法来描绘父母与子女之间的关系。

总体而言，这应该足够了，具体取决于您的需求。您可以根据需要进行调整。如果您有疑问，请问：）。

Answer 2

我想让工作表的输出看起来像树命令的结果

在我看来，最简单的方法就是使用Tree命令。

这是一种方法，但细节肯定可以改变：

在基础文件夹
将输出写入某个文本文件（代码中指定的位置和名称）
在Excel中将文件作为文本文件打开
拆分为垂直条上的列（Unicode字符9474），树命令用于区分级别
我使用WSH.Run方法，因为它可以轻松隐藏CMD窗口
- 可以使用WSH.Exec方法将输出直接传递给VBA变量，但隐藏CMD窗口要困难得多（意思是，在另一个应用程序中，我无法使用to）： - ）

还可以将文本文件导入到同一工作簿中，而不是打开新文件。如果你选择这样做，我会把这个练习留给你。

Option Explicit
'set referennce to Windows Script Host Object Model
Sub DirTree()
    Dim sBaseFolder As String, sTempFile As String
    Dim WSH As WshShell
    Dim sCMD As String
    Dim lErrCode As Long


'Many ways to set starting point
sBaseFolder = Environ("HOMEDRIVE") & "\"
sTempFile = Environ("TEMP") & "\Tree.txt"

'Command line
sCMD = "CMD /c tree """ & sBaseFolder & """ > """ & sTempFile & """"

Set WSH = New WshShell
lErrCode = WSH.Run(sCMD, xlHidden, True)

If Not lErrCode = 0 Then
    MsgBox "Error in execution: Code - " & lErrCode
Else
    'Open the file
    Workbooks.OpenText Filename:=sTempFile, Origin:=xlMSDOS, _
        StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
        ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False, Comma:=False _
        , Space:=False, Other:=True, OtherChar:=ChrW(&H2502), _
        FieldInfo:=Array(Array(1, 1), Array(2, 1))
End If

End Sub

以下是在我的C:驱动器

上运行时输出开头的屏幕截图

编辑：由于您现在提到您希望链接可以点击，因此使用dir的方法可能会更简单，尤其是因为您可以为{{1}提供参数}命令将导致返回完整路径。

我使用了一个类模块，以便拥有一个用户定义的对象，它具有必要的信息;和适当过滤后的这些对象的字典。

我选择仅在单元格中显示文件夹名称，但屏幕提示将显示完整路径。

请注意需要设置的引用（在代码中）。另请注意，必须重命名类模块： cTree

编辑2：编辑了Regular和Class模块，以允许选择列出文件。请注意，宏现在有一个参数，因此必须从另一个宏或直接窗口调用它以包含参数。（该参数也可以从输入框，用户表单等获得，但我现在这样做是因为它更简单。

我没有添加文件的超链接，认为它会让人感到困惑，因为不同的程序和对话框（文件浏览器除外）会根据扩展名打开。

班级单元

dir

常规模块

Option Explicit
'Rename Class Module:  cTree

Private pFullPath As String
Private pFolderName As String
Private pLevel As Long
Private pFile As String
Private pFiles As Dictionary

Public Property Get FullPath() As String
    FullPath = pFullPath
End Property
Public Property Let FullPath(Value As String)
    pFullPath = Value
End Property

Public Property Get FolderName() As String
    FolderName = pFolderName
End Property
Public Property Let FolderName(Value As String)
    pFolderName = Value
End Property

Public Property Get Level() As Long
    Level = pLevel
End Property
Public Property Let Level(Value As Long)
    pLevel = Value
End Property

Public Property Get Files() As Dictionary
    Set Files = pFiles
End Property
Public Function ADDfile(Value As String)
    pFiles.Add Value, Value
End Function
Private Sub Class_Initialize()
    Set pFiles = New Dictionary
    pFiles.CompareMode = TextCompare
End Sub

没有文件列表的结果

文件列表

的结果

Answer 3

我不认为LIFO或FIFO很重要，只要看看这个想法。

Sub GetFilesInFolder(SourceFolderName As String)

'--- For Example:Folder Name= "D:\Folder Name\"

Dim FSO As Scripting.FileSystemObject
Dim SourceFolder As Scripting.folder, SubFolder As Scripting.folder
Dim FileItem As Scripting.File

Set FSO = New Scripting.FileSystemObject
Set SourceFolder = FSO.GetFolder(SourceFolderName)

'--- This is for displaying, whereever you want can be configured

r = 14
For Each FileItem In SourceFolder.Files
    Cells(r, 2).Formula = r - 13
    Cells(r, 3).Formula = FileItem.Name
    Cells(r, 4).Formula = FileItem.Path
    Cells(r, 5).Formula = FileItem.Size
    Cells(r, 6).Formula = FileItem.Type
    Cells(r, 7).Formula = FileItem.DateLastModified
    Cells(r, 8).Formula = "=HYPERLINK(""" & FileItem.Path & """,""" & "Click Here to Open" & """)"

    r = r + 1   ' next row number
Next FileItem

Set FileItem = Nothing
Set SourceFolder = Nothing
Set FSO = Nothing

End Sub

ii）用户想要获取文件夹内所有文件的列表以及子文件夹复制并粘贴以下代码，这将列出文件夹内所有文件的列表以及子文件夹。如果某些其他子文件夹中还有其他文件，那么它将列出每个文件夹和每个文件夹和子文件夹中的所有文件。

Sub GetFilesInFolder(SourceFolderName As String, Subfolders As Boolean)

'--- For Example:Folder Name= "D:\Folder Name\" and Flag as Yes or No

Dim FSO As Scripting.FileSystemObject
Dim SourceFolder As Scripting.folder, SubFolder As Scripting.folder
Dim FileItem As Scripting.File
'Dim r As Long
    Set FSO = New Scripting.FileSystemObject
    Set SourceFolder = FSO.GetFolder(SourceFolderName)

    '--- This is for displaying, whereever you want can be configured

    r = 14
    For Each FileItem In SourceFolder.Files
        Cells(r, 2).Formula = r - 13
        Cells(r, 3).Formula = FileItem.Name
        Cells(r, 4).Formula = FileItem.Path
        Cells(r, 5).Formula = FileItem.Size
        Cells(r, 6).Formula = FileItem.Type
        Cells(r, 7).Formula = FileItem.DateLastModified
        Cells(r, 8).Formula = "=HYPERLINK(""" & FileItem.Path & """,""" & "Click Here to Open" & """)"

        r = r + 1   ' next row number
    Next FileItem

    '--- This is the Function to go each and Every Folder and get the Files. This is a Nested-Function Calling.

    If Subfolders = True Then
        For Each SubFolder In SourceFolder.Subfolders
            ListFilesInFolder SubFolder.Path, True
        Next SubFolder
    End If

    Set FileItem = Nothing
    Set SourceFolder = Nothing
    Set FSO = Nothing
End Sub

使用Excel工作簿中的Excel宏的文件管理器

我使用上面的代码创建了一个文件管理器。它基本上从文件夹和子文件夹中提取文件列表并列出它们。它获取文件的其他详细信息，如文件大小，上次修改，文件路径，文件类型以及通过单击直接从Excel打开文件的超链接。它看起来像下面这样：

以下是下载完整工作簿的链接。

http://learnexcelmacro.com/wp/2011/11/how-to-get-list-of-all-files-in-a-folder-and-sub-folders/

单击名为“立即下载”的按钮。

循环遍历所有子文件夹 - VBA - 队列方法

3 个答案: