Петля через все подпапки с использованием VBA

Я ищу VBA script, который будет проходить через все подпапки указанной папки. Когда я говорю все вложенные папки, я имею в виду каждую папку внутри указанной папки и каждую папку внутри этого и каждую папку внутри этого... в теории могут быть бесконечные вложенные подпапки, но на самом деле она, вероятно, не будет превышать 3 или 4. Я использую объекты Runtime VBA Scripting Runtime, так что, как только я запишусь в папку, я могу проверить свойства некоторых файлов (но я знаю, как сделать эту часть).

Благодарим за помощь!

Этот вопрос отличается от перечисленных "похожих" вопросов в предыдущих вопросах, содержащих известные каталоги, тогда как потребность здесь заключалась в поиске известных и неизвестных каталогов. Также необходимо несколько слоев подкаталогов. Вы, ребята, действительно должны просто прочитать вопрос, прежде чем стрелять из "дубликата".

Ответ 1

Просто простая папка развернется.

Dim FileSystem As Object
Dim HostFolder As String

HostFolder = "C:\"

Set FileSystem = CreateObject("Scripting.FileSystemObject")
DoFolder FileSystem.GetFolder(HostFolder)

Sub DoFolder(Folder)
    Dim SubFolder
    For Each SubFolder In Folder.SubFolders
        DoFolder SubFolder
    Next
    Dim File
    For Each File In Folder.Files
        ' Operate on each file
    Next
End Sub

Ответ 2

И чтобы дополнить Rich recursive answer, нерекурсивный метод.

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(1)
        queue.Remove 1 'dequeue
        '...insert any folder processing code here...
        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

Вы можете использовать очередь для поведения FIFO (показано выше), или вы можете использовать стек для LIFO-поведения, который будет обрабатываться в том же порядке, что и рекурсивный подход (замените Set oFolder = queue(1) на Set oFolder = queue(queue.Count) и замените queue.Remove(1) с queue.Remove(queue.Count) и, возможно, переименуйте переменную...)