excelvbafilesystemobject

List folder names and count number of files in each folder


I found code on YouTube.

  1. It counts Excel files.
    How can it read all the extensions in a folder?

  2. It counts one directory.
    How can it read the subfolders and count files in them as well?

  3. It displays the count answer in a message box.
    How can it display the answer in Column B?

E.g. There are five subfolders and each contains files with different extensions.

The code should read all the subfolders and list 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

Example


Solution

  • 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