To list Folders name and count number of files in each folder-CodePudding

I need help in the code i have found from youtube and request if anyone could please edit it so that it displays the following requirement.

currently it only counts excel files, Can anyone please edit so that it should read all the extension in folder(s).

Secondly it just count one main directory, is it possible if it can be edited so it should read the subfolders and count files in them as well.

third for now it displays the count answer in a message box, it is possible if it displays the answer in Column B.

E.g. There are 5 sub folders with different names and each folder contains files with different extensions.

The code can read all the Subfolders and list down the name of folder in excel and also count and return the answer in front of each folder name.

Sub CountFiles()
    Dim strDir As String
    Dim fso As Object
    Dim objFiles As Object
    Dim obj As Object
    Dim lngFileCount As Long
       
    strDir = "E:\2022\"
   
    Set fso = CreateObject("Scripting.FileSystemObject")
   
    Set objFiles = fso.GetFolder(strDir).Files
   
    lngFileCount = objFiles.count
   
    MsgBox lngFileCount     'Total number of files
   
   
    '***************************************************
    'NOTE: Ensure that the following code does not overwrite _
     anything in your workbook.
    'Active worksheet should be a blank worksheet
   
    For Each obj In objFiles
      ActiveSheet.Cells(Rows.count, "A").End(xlUp).Offset(1, 0) = obj.Name
    Next obj
   
    Set objFiles = Nothing
    Set fso = Nothing
    Set obj = Nothing
   
End Sub

I shall remain thankful

CodePudding user response：

List Subfolders

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, "B").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
   
    ' Inform.
    MsgBox "Folders listed.", vbInformation
   
End Sub