VBA to List all Folders, Subfolders and files in a directory

[acrete]

Hi all, I found many examples that prints file directories into a spreadsheet. I am trying to create a VBA in Excel that replicates a cmd script to list out contents of a folder, subfolders and files

tree "C:\list\" > C:\list\details.txt" /A /F

The spreadsheet needs to cascade so column A lists the files in the directory, column b lists the subfolders, column c lists the files in the subfolders, column d lists subfolders of the subfolder, etc....

Any help would be much appreciated. Thanks!

 

[John_w]

Try this macro. The usual method of processing folders, files and subfolders is a procedure which calls itself (a recursive procedure), however I decided to use a stack structure implemented as 2 VBA Collections for the folders and folder levels, which are kept in sync. This avoids the need to use a class module to store both properties.

Option Explicit

Public Sub Main_List_Folders_and_Files()

    With ActiveSheet
        .Cells.Clear
        List_Folders_and_Files "C:\list", .Range("A1")
    End With

End Sub


Private Function List_Folders_and_Files(folderPath As String, destCell As Range) As Long

    Dim FSO As Object
    Dim FSfolder As Object, FSsubfolder As Object, FSfile As Object
    Dim folders As Collection, levels As Collection
    Dim subfoldersColl As Collection
    Dim n As Long, c As Long, i As Long
    
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set folders = New Collection
    Set levels = New Collection
    
    'Add start folder to stack
    
    folders.Add FSO.GetFolder(folderPath)
    levels.Add 0
       
    n = 0

    Do While folders.Count > 0
    
        'Remove next folder from top of stack
        
        Set FSfolder = folders(folders.Count): folders.Remove folders.Count
        c = levels(levels.Count): levels.Remove levels.Count
        
        'Output this folder and its files
        
        destCell.Offset(n, c).Value = "'" & FSfolder.Name
        n = n + 1
        c = c + 1
        For Each FSfile In FSfolder.Files
            destCell.Offset(n, c).Value = "'" & FSfile.Name
            n = n + 1
        Next
               
        'Get collection of subfolders in this folder
        
        Set subfoldersColl = New Collection
        For Each FSsubfolder In FSfolder.SubFolders
            subfoldersColl.Add FSsubfolder
        Next
        
        'Loop through collection in reverse order and put each subfolder on top of stack.  As a result, the subfolders are processed and
        'output in the correct ascending ASCII order
        
        For i = subfoldersColl.Count To 1 Step -1
            If folders.Count = 0 Then
                folders.Add subfoldersColl(i)
                levels.Add c
            Else
                folders.Add subfoldersColl(i), , , folders.Count
                levels.Add c, , , levels.Count
            End If
        Next
        Set subfoldersColl = Nothing
                
    Loop
    
    List_Folders_and_Files = n

End Function

 

[abdo meghari]

@John_w thanks for your code . just question how add hyperlink to open folder or subfolder or file?

 

[John_w]

just question how add hyperlink to open folder or subfolder or file?

Make these two changes:

        'destCell.Offset(n, c).Value = "'" & FSfolder.Name  'OLD
        destCell.Worksheet.Hyperlinks.Add Anchor:=destCell.Offset(n, c), Address:=FSfolder.path, TextToDisplay:=FSfolder.Name

            'destCell.Offset(n, c).Value = "'" & FSfile.Name 'OLD
            destCell.Worksheet.Hyperlinks.Add Anchor:=destCell.Offset(n, c), Address:=FSfile.path, TextToDisplay:=FSfile.Name

 

[abdo meghari]

great ! thank for that .

 

[mrsoliveira]

One more question, how to create a column right with date of created folder?

Or How to read directories since root level in this vba:

Sub sbListAllFolderDetails()
    
    'Disable screen update
    Application.ScreenUpdating = False
    
    'Variable Declaration
    Dim shtFldDetails As Worksheet
    Dim sRootFolderName As String
    
    'Browse Root Folder
    sRootFolderName = sbBrowesFolder & "\"
    
    'If path is not available, it display message and exit from the procedure
    If sRootFolderName = "\" Then
        MsgBox "Please select folder to find list of folders and Subfolders", vbInformation, "Input Required!"
        Exit Sub
    End If
    
    'Delete Sheet if it exists
    Application.DisplayAlerts = False
        On Error Resume Next
        ActiveWorkbook.Sheets("Folder Details").Delete
    Application.DisplayAlerts = True
    
    'Add new Worksheet and name it as 'Folder Details'
    With ThisWorkbook
        Set shtFldDetails = .Sheets.Add(After:=.Sheets(.Sheets.Count))
        shtFldDetails.Name = "Folder Details"
    End With
    
    'Create object for sheet name
    Set shtFldDetails = Sheets("Folder Details")
    
    'Clear Sheet
    shtFldDetails.Cells.Clear
    
    'Main Header and its Fomat
    With shtFldDetails.Range("A1")
        .Value = "Folder and SubFolder Details"
        .Font.Bold = True
        .Font.Size = 12
        .Interior.ThemeColor = xlThemeColorDark2
        .Font.Size = 14
        .HorizontalAlignment = xlCenter
    End With
    
    With shtFldDetails
        'Merge Header cells
        .Range("A1:H1").Merge
    
        'Create Headers
        .Range("A2") = "Folder Path"
        .Range("B2") = "Short Folder Path"
        .Range("C2") = "Folder Name"
        .Range("D2") = "Short Folder Name"
        .Range("E2") = "Number of Subfolders"
        .Range("F2") = "Number of Files"
        .Range("G2") = "Folder Size"
        .Range("H2") = "Folder Create Date"
        
        .Range("A2:H2").Font.Bold = True
    End With
    
    'Call Sub Procedure
    'List all folders & subfolders
    sbListAllFolders sRootFolderName
    
    'Enable Screen Update
    Application.ScreenUpdating = True
    
End Sub

Sub sbListAllFolders(ByVal SourceFolder As String)
    
    'Variable Declaration
    Dim oFSO As Object, oSourceFolder As Object, oSubFolder As Object
    Dim iLstRow As Integer
            
    'Create object to FileSystemObject
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    Set oSourceFolder = oFSO.GetFolder(SourceFolder)
    
    'Define Start Row
    iLstRow = Sheets("Folder Details").Cells(Sheets("Folder Details").Rows.Count, "A").End(xlUp).Row + 1
    
    'Update Folder properties to Sheet
    With Sheets("Folder Details")
        .Range("A" & iLstRow) = oSourceFolder.Path
        .Range("B" & iLstRow) = oSourceFolder.ShortPath
        .Range("C" & iLstRow) = oSourceFolder.Name
        .Range("D" & iLstRow) = oSourceFolder.ShortName
        .Range("E" & iLstRow) = oSourceFolder.SubFolders.Count
        .Range("F" & iLstRow) = oSourceFolder.Files.Count
        .Range("G" & iLstRow) = oSourceFolder.Size
        .Range("H" & iLstRow) = oSourceFolder.datecreated
    End With
        
    'Loop through all Sub folders
    For Each oSubFolder In oSourceFolder.SubFolders
        sbListAllFolders oSubFolder.Path
    Next oSubFolder
    
    'Autofit content in respective columns
    Sheets("Folder Details").Columns("A:H").AutoFit
    
    'Release Objects
    Set oSubFolder = Nothing
    Set oSourceFolder = Nothing
    Set oFSO = Nothing


End Sub

Public Function sbBrowesFolder()
    Dim FldrPicker As FileDialog
    Dim myPath As String
        
    'Browse Folder Path
    Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)
    
      With FldrPicker
        .Title = "Browse Root Folder Path"
        .AllowMultiSelect = False
          If .Show <> -1 Then Exit Function
          myPath = .SelectedItems(1)
      End With
 
      sbBrowesFolder = myPath
      If myPath = vbNullString Then Exit Function

End Function

Thanks in advice

 

[Kdilas]

John,
This is an AWESOME Macro, Thank you for sharing with the group! I actually found this post while looking for something else but this solved another issue I needed to address. Thank You again!!

 

[howeyes]

Instead of listing folders in separate columns how can I modify the code to have two columns - one column the complete folder name and the the other the file name?

 

[John_w]

Instead of listing folders in separate columns how can I modify the code to have two columns - one column the complete folder name and the the other the file name?

Please start a new thread, referencing this one if necessary, and show exactly the layout you want.

 

[howeyes]

Please start a new thread, referencing this one if necessary, and show exactly the layout you want.

I found a better solution on your website.