iterating through all sub folders in a folder

[Lino]

Hello,

does any one have a snippet of code that will iterate through sub folders in a folder?

thanks,

Lino

 

[Nimrod]

Option Compare Text

Public Sub ListAllFilesInSubDir()
    Call SubDirs("c:\test\", 0)
End Sub

Public Sub SubDirs(StartPath, DepthCount)
'StartPath = "c:\test\"

     Dim fs, f, f1, s, sf, f2, ff
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.GetFolder(StartPath)
    Set sf = f.SubFolders
    
    DepthCnt = DepthCount + 1
    
    ' EACH SUB DIRECTORY
    For Each f1 In sf
    
        ' Current Sub-DIR Name
        MsgBox f1.Name
        
        ' Current Sub-DIR Depth eg how far down from original path
        MsgBox DepthCnt
        
        
        ' List all files in current dir
        Call EnumFilesInPath("Sheet1", f1.Path)
        
        ' Recursively go down the Dir tree
        Call SubDirs(f1.Path, DepthCnt)
        
    Next f1
    
End Sub

Private Sub EnumFilesInPath(SheetName, Path)
    Dim fs, f, f1, fc, s
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.GetFolder(Path)
    Set fc = f.Files
    Col = 0
    With Sheets(SheetName)
    'ADD HEADERS
    For Each Hdr In Array("Name", "Extension", "Type", "Size(bytes)", "Created", _
    "Lst Access", "Modified", "Drive", "Path", "Attributes")
    Col = Col + 1
    Cells(1, Col).Value = Hdr
    Next Hdr
    For Each f1 In fc
    NxRw = .Cells(65536, 1).End(xlUp).Row + 1
    'NAME
    .Cells(NxRw, 1).Value = f1.Name
    'EXTENSION
    .Cells(NxRw, 2).Value = fs.GetExtensionName(f1)
    'TYPE
    .Cells(NxRw, 3).Value = f1.Type
    'SIZE
    .Cells(NxRw, 4).Value = f1.Size
    'CREATION DATE
    .Cells(NxRw, 5).Value = f1.DateCreated
    'LAST ACCESS DATE
    .Cells(NxRw, 6).Value = f1.DateLastAccessed
    'LAST MOD DATE
    .Cells(NxRw, 7).Value = f1.DateLastModified
    'DRIVE
    .Cells(NxRw, 8).Value = f1.Drive
    'PATH
    .Cells(NxRw, 9).Value = f1.Path
    
    Next
    End With
    ' Sort By File Type
    Cells.Sort Key1:=Range("B3"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
        
    
End Sub