new - Pasa por todas las subcarpetas usando VBA

new filesystemobject vb6

Question

Esta pregunta ya tiene una respuesta aquí:

• Ciclo a través de subcarpetas y archivos en un directorio raíz especificado por el usuario [duplicado] 3 respuestas

Estoy buscando un script de VBA que recorra todas las subcarpetas de una carpeta especificada. Cuando digo todas las subcarpetas, quiero decir cada carpeta dentro de la carpeta especificada, y cada carpeta dentro de esa, y cada carpeta dentro de eso ... en teoría podría haber subcarpetas anidadas infinitas, pero en realidad probablemente no irá por encima de 3 o 4. Estoy usando los objetos VBA Scripting Runtime, de modo que una vez que entre en la carpeta puedo verificar las propiedades de algunos archivos (pero sé cómo hacer esa parte).

¡Gracias por tu ayuda!

Esta pregunta es diferente de las preguntas "similares" enumeradas en las preguntas anteriores que contenían directorios conocidos, mientras que la necesidad aquí era encontrar directorios conocidos y desconocidos. También se necesitan varias capas de subdirectorios. Ustedes deberían leer la pregunta antes de disparar "duplicar".

Answer 1

Solo una simple carpeta profundizar.

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

Answer 2

Y para complementar la respuesta recursiva de Rich, un método no recursivo.

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

Puede usar una cola para el comportamiento FIFO (mostrado arriba), o puede usar una pila para el comportamiento LIFO que se procesaría en el mismo orden que un enfoque recursivo (reemplace Set oFolder = queue(1) con Set oFolder = queue(queue.Count) y reemplace queue.Remove(1) con queue.Remove(queue.Count) , y probablemente cambie el nombre de la variable ...)