To Count number of files in each of folder and subfolder - excel

Question

Yesterday i have been provided with a wonderful code by #VBasic2008 that is working perfectly fine.
In a parent directory if there are 500 subfolders, the code lists down the names of each subfolder in excel sheet and also count number of files available in each subfolder and return the value in excel sheet as well and by this way I am able to verify which folders have how many files in it.
However, I request I need to add one more step in it which is difficult for me.
I have noticed that within each subfolders there are 3 to 4 more folders and the files are organized in these folders extension wise (see below screenshot). means in each subfolders there are (Zip) (Word) (PDF) (XML) etc.
Is there any possibility where the code can also read these folders which are in each subfolder and can return the answer like mentioned below
If the result is not possible the way i suggested above than any format will be okay. but the only requirement is that it can read the folder properties within each subfolder and can return result.
Sub ListSubfolders()
' Define constants.
Const FolderPath As String = "E:\2022\"
' Reference the folder.
Dim fso As Object: Set fso = CreateObject("Scripting.FileSystemObject")
If Not fso.FolderExists(FolderPath) Then
MsgBox "The folder """ & FolderPath & """ doesn't exist.", vbCritical
Exit Sub
End If
Dim fsoFolder As Object: Set fsoFolder = fso.GetFolder(FolderPath)
' Reference the first cell.
If ActiveSheet Is Nothing Then Exit Sub ' no visible workbooks open
If Not TypeOf ActiveSheet Is Worksheet Then Exit Sub ' not a worksheet
Dim ws As Worksheet: Set ws = ActiveSheet
Dim fCell As Range
Set fCell = ws.Cells(ws.Rows.Count, "A").End(xlUp).Offset(1)
' Write the folder properties.
' If you don't want this, then out-comment it but also copy the line
' 'Set fCell = fCell.Offset(1)' to the bottom of the loop.
fCell.Value = fsoFolder.Name
fCell.Offset(, 1).Value = fsoFolder.Files.Count
' Write the subfolders' properties.
Dim fsoSubfolder As Object
For Each fsoSubfolder In fsoFolder.SubFolders
Set fCell = fCell.Offset(1)
fCell.Value = fsoSubfolder.Name
fCell.Offset(, 1).Value = fsoSubfolder.Files.Count
Next fsoSubfolder
End Sub
This will be much appreciated.

Answer 1

I can not see the images that you put in your question, but you can do a recursive function to count all files in subfolders
In example bellow, in first cell of each subdirectory is put a number indicating the sublevel, then in column of that sublevel is the name and the total of files is in the next column.
Sub CountAllFiles()
Const FolderPath As String = "E:\2022\"
' Reference the folder.
Dim fso As Object: Set fso = CreateObject("Scripting.FileSystemObject")
If Not fso.FolderExists(FolderPath) Then
MsgBox "The folder """ & FolderPath & """ doesn't exist.", vbCritical
Exit Sub
End If
Dim fsoFolder As Object: Set fsoFolder = fso.GetFolder(FolderPath)
' Reference the first cell.
If ActiveSheet Is Nothing Then Exit Sub ' no visible workbooks open
If Not TypeOf ActiveSheet Is Worksheet Then Exit Sub ' not a worksheet
Dim ws As Worksheet: Set ws = ActiveSheet
Dim fCell As Range
Set fCell = ws.Cells(ws.Rows.Count, "A").End(xlUp).Offset(1)
' Write the folder properties.
' If you don't want this, then out-comment it but also copy the line
' 'Set fCell = fCell.Offset(1)' to the bottom of the loop.
fCell.Value = fsoFolder.Name
fCell.Offset(, 1).Value = fsoFolder.Files.Count
' Write the subfolders' properties.
Dim fsoSubfolder As Object
For Each fsoSubfolder In fsoFolder.SubFolders
Set fCell = ws.Cells(ws.Rows.Count, "A").End(xlUp).Offset(1)
fCell.Value = fsoSubfolder.Name
fCell.Offset(, 1).Value = fsoSubfolder.Files.Count
Call countFiles(ws, fCell.Row, fsoSubfolder)
Next fsoSubfolder
End Sub
Sub countFiles(ByVal ws As Worksheet, ByVal pRow As Integer, ByVal pFsoSubfolder As Object)
Dim col As Integer
Dim totCol As Integer
Dim foundName As Boolean
For Each fsoSubfolder In pFsoSubfolder.SubFolders
' find subfolder name in columns
totCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
foundName = False
For col = 3 To totCol
If ws.Cells(1, col).Value = fsoSubfolder.Name Then
foundName = True
Exit For
End If
Next col
If Not foundName Then
ws.Cells(1, col).Value = "'" & fsoSubfolder.Name
End If
ws.Cells(pRow, col).Value = "'" & fsoSubfolder.Files.Count
Call countFiles(ws, pRow, fsoSubfolder)
Next fsoSubfolder
End Sub