VB to list top 4 levels of folder structure

[scotthannaford1973]

Hi - I'd like to be able to create a list of the paths for all folders in the top four folder levels of a particular drive - in this case the M drive - and to show the full path for those folders. I am aware that it can be done using Power Excel, but I want to use VB so anyone can use this.

so e.g.
M:/
M:/Folder 1/
M:/Folder 1/Sub-Folder 1/
M:/Folder 1/Sub-Folder 1/Sub-Sub-Folder1

etc etc

TIA

 

[John_w]

Try this macro:

Public Sub List_Folder_Paths()

    Dim startFolder As String
    Dim lines() As String, paths() As String
    Dim n As Long, i As Long
    
    startFolder = "M:\"
    
    lines = Split(CreateObject("WScript.Shell").Exec("cmd /c DIR """ & startFolder & """ /AD-S /S /B").StdOut.ReadAll, vbCrLf)
    
    ReDim paths(UBound(lines) - 1, 0)
    n = 0
    For i = 0 To UBound(lines) - 1
        If UBound(Split(lines(i), "\")) <= 4 Then
            paths(n, 0) = lines(i)
            n = n + 1
        End If
    Next
    
    With ActiveSheet
        .Cells.Clear
        .Range("A1").Value = "Folder paths " & startFolder
        .Range("A2").Resize(n) = paths
    End With
    
End Sub

 

[scotthannaford1973]

thanks, John - will give that a go.. is the "<= 4 Then" where you specify the number of folder levels?

 

[scotthannaford1973]

Hi John - for some reason, when I run the command, the cmd box stays open - and eventually I have to close it - at which point I just see the first level of sub-folders and no sub-folders. Any ideas? (btw I tweaked it to start from M:\Acute\ICT\Digital Programme and Projects\ rather than M:\)

cheers!

 

[Georgiboy]

Maybe the below will help, you would need to change the path in the 'test' sub. It is the 'test' sub you would run:

Sub test()
    ListFolders "C:\PATH-HERE\", 1, 1
End Sub

Sub ListFolders(ByVal folderPath As String, ByVal folderLevel As Integer, ByRef currentRow As Long)
    Dim folder As Object
    Dim subFolder As Object
    
    ' Get a reference to the current folder
    Set folder = CreateObject("Scripting.FileSystemObject").GetFolder(folderPath)
    
    ' Write the folder path to the worksheet
    Cells(currentRow, folderLevel).Value = folderPath
    
    ' Increment the current row
    currentRow = currentRow + 1
    
    ' Check if the maximum folder level has been reached
    If folderLevel >= 4 Then Exit Sub
    
    ' Loop through subfolders and call the function recursively
    For Each subFolder In folder.SubFolders
        ListFolders subFolder.Path, folderLevel + 1, currentRow
    Next subFolder
End Sub

 

[John_w]

Hi John - for some reason, when I run the command, the cmd box stays open - and eventually I have to close it - at which point I just see the first level of sub-folders and no sub-folders. Any ideas? (btw I tweaked it to start from M:\Acute\ICT\Digital Programme and Projects\ rather than M:\)

Try this test macro which runs the same DIR command and keeps the command window open so you can see if any errors occur.

Private Sub Test()
    Dim startFolder As String
    startFolder = "M:\Acute\ICT\Digital Programme and Projects\"
    CreateObject("WScript.Shell").Run "cmd /k DIR """ & startFolder & """ /AD-S /S /B"
End Sub

Maybe the below will help,

Thanks for your code - a very good option which should definitely work, but is likely to be slow if there are many subfolders in the start folder.