Macro to list and count folders and "one level" subfolders

[Amine]

Hello,
I have spent the whole day looking for a macro that would allow me to list and count folders and their subfolders BUT excluding the sub-sub...folders. I would be very thankful if someone could provide me with such a macro that would:
1- Ask me to browse and choose the main folder
2- Look for the folders under the main folder and their subfolders only
3- List and count the files and folders in both the folders and their subfolders
4- put the results on the same sheets everytime I do run the macro

I suppose my ask is complex and would require some time to build, but I would really appreciate any help from the experts!

Many thanks upfront.
A.

 

[Amine]

Does that mean that my problem cannot be solved?? At least post a no so I get rid of this macro.. thx

 

[John_w]

The usual method when you need to loop through files in folders and subfolders is with a recursive procedure using FileSystemObject and its related objects. It can also be done with the VBA Dir function but requires more code.

For your requirement which I understand to be 2 levels of subfolder from the main folder (not 1), you would need to pass the folder level as an additional argument to the recursive procedure.

 

[Amine]

Thanks John for the effort. I am not that bad when it comes to macros and VBA, but to be honest I couldnt figure out how I could setup the loop so it stops after getting to the 2nd level subfolder. Any hint or support how to build this macro part would be very welcome.

 

[John_w]

Try this. You didn't say how you want the listing to be laid out in the cells, but you should be able to modify it exactly as required.

Public Sub Folders_and_Files_Listing()

    Dim startCell As Range
    
    With ActiveSheet
        Set startCell = .Range("A1")
        .Cells.Clear
    End With
    
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Select main folder"
        .Show
        If .SelectedItems.Count > 0 Then
            Application.ScreenUpdating = False
            List_Subfolders_to_Level startCell, .SelectedItems(1), 2
            Application.ScreenUpdating = True
        End If
    End With

End Sub


'For all subfolders in the specified folder path, output subfolder path, file count and file names to cells
'and return the total number of rows output

Private Function List_Subfolders_to_Level(destCell As Range, folderPath As String, folderLevel As Integer) As Long

    Dim FSO As Object
    Dim thisFolder As Object, subfolder As Object
    Dim n As Long
    
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set thisFolder = FSO.GetFolder(folderPath)
        
    n = 0
    For Each subfolder In thisFolder.subfolders
        n = n + List_Subfolders_and_Files(destCell.Offset(n, 0), FSO, subfolder.path, folderLevel - 1)
    Next
    
    List_Subfolders_to_Level = n

End Function


'Output specified folder path, file count and file names to cells and call recursively for subfolders
'up to the specified folder level.  Return the number of rows output

Private Function List_Subfolders_and_Files(destCell As Range, FSO As Object, _
    folderPath As String, folderLevel As Integer) As Long

    Dim thisFolder As Object, subfolder As Object
    Dim fileItem As Object
    Dim n As Long
    
    DoEvents
    Set thisFolder = FSO.GetFolder(folderPath)
        
    'Output folder path, file count and file names
    
    n = 0
    destCell.Offset(n, 0).Value = thisFolder.path
    destCell.Offset(n, 1).Value = thisFolder.Files.Count & IIf(thisFolder.Files.Count = 1, " file", " files")
    n = n + 1
    
    For Each fileItem In thisFolder.Files
        destCell.Offset(n, 2).Value = fileItem.Name
        n = n + 1
    Next
        
    If folderLevel > 0 Then
        
        'Do subfolders in this folder
        
        For Each subfolder In thisFolder.subfolders
            n = n + List_Subfolders_and_Files(destCell.Offset(n, 0), FSO, subfolder.path, folderLevel - 1)
        Next
    
    End If
        
    List_Subfolders_and_Files = n

End Function

 

[Amine]

this works like a charm!!! I had to tweak the code a bit, but it is what I was looking for, Thx John!