Macro to count the number of files in folder and subfolders

[LisaLou]

Hello,

I am really hoping someone can help me with this. I have VBA code to count the numbers of files in folders but I also need to count the number of files in sub folders too which the total will be displayed in cells in the excel spreadsheet. This is the code I have for counting in folders:

Private Sub countBatches()

Dim FolderPath As String, path As String, count As Integer, dayid As String

dayid = Range("B1").Value

FolderPath = "C:\Users\Lisap\OneDrive\Desktop\Orders\" & dayid & "\Batches"

path = FolderPath & "\*"

Filename = Dir(path)

Do While Filename <> ""
count = count + 1
Filename = Dir()
Loop

Range("B2").Value = count

End Sub


Please can anyone help with this? I would be most grateful!

 

[Fluff]

You're welcome & thanks for the feedback.

 

[LisaLou]

Hi,

I am really sorry but I am struggling to get this to work, please can you take a look? I am relatively new to VBA and learning as I go along.... Thank you so much.

Private Sub Worksheet_Change(ByVal Target As Range)
   Dim fso As Object, StartFldr As Object
   Dim StartPth As String, DayId As String
   If Target.CountLarge > 1 Then Exit Sub
   If Target.Address(0, 0) = "B1" Then
      DayId = Range("B1").Value
      StartPth = "C:\Users\Lisap\OneDrive\Desktop\Orders\" & DayId & "\Batches"
      
      Set fso = CreateObject("Scripting.FileSystemObject")
      Set StartFldr = fso.GetFolder(StartPth)
      Call RecursiveFolder(fso, StartFldr, True)
   End If
End Sub

Sub figures()

   Dim fso As Object, StartFldr As Object
   Dim StartPth As String, DayId As String
  
   DayId = Range("B1").Value
   StartPth = "C:\Users\Lisap\OneDrive\Desktop\Orders\" & DayId & "\Batches"
  
   Set fso = CreateObject("Scripting.FileSystemObject")
   Set StartFldr = fso.GetFolder(StartPth)
   Call RecursiveFolder(fso, StartFldr, True)


End Sub
Sub figures()

Sub RecursiveFolder(fso As Object, Fldr As Object, IncludeSubFolders As Boolean)
   Dim FldrFile As Object
   Dim SubFldr As Object
   Dim NxtRw As Long
  
   Range("B2") = Range("B2") + Fldr.Files.Count
  
   If IncludeSubFolders Then
      For Each SubFldr In Fldr.SubFolders
         Call RecursiveFolder(fso, SubFldr, True)
      Next SubFldr
   End If
End Sub

 

[Fluff]

You need to remove the bit in red

End Sub
Sub figures()

Sub RecursiveFolder(fso As Object, Fldr As Object, IncludeSubFolders As Boolean)

 

[LisaLou]

You need to remove the bit in red

End Sub
Sub figures()

Sub RecursiveFolder(fso As Object, Fldr As Object, IncludeSubFolders As Boolean)

Thank you so much! one last question, how do I get it to work that once I enter the date and press enter it will run the macro?

 

[Fluff]

That's what the change event does, as long as you have placed it in the relevant sheet module.

 

[LisaLou]

I really do appreciate the help.

This is the spreadsheet I have:

Date	110321​
Unallocated Batches
Completed Queries ULPF
Completed Queries UJAC
Printed
Queries to do
ULPF
UJAC
USAE

What I would like is when I enter the date in cell B1 and press ENTER the macro will search the folders and subfolders to find the number of files in those folders and display the counts in column B next to each folder which is shown above.

The folders which are highlighted in red have subfolders which I need a total quantity of files in those folders (don't need it splitting into how many files in each subfolder).

The code which I have been trying to work with is:

Private Sub Worksheet_Change(ByVal Target As Range)

End Sub

    
    If Target.Address = "$B$1" Then
    
        Call countBatches
        Call countComplete
        Call countQueries_Completed_Queries_UJAC
        Call countQueries_Completed_Queries_ULPF
        Call countQueries_Completed_Queries_USAE
        Call countQueries_Printed
        Call countQueries
        Call countULPF
        Call countUJAC
        Call countUSAE
End If
    
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
   Dim fso As Object, StartFldr As Object
   Dim StartPth As String, DayId As String
   If Target.CountLarge > 1 Then Exit Sub
   If Target.Address(0, 0) = "B1" Then
      DayId = Range("B1").Value
      StartPth = "C:\Users\Lisap\OneDrive\Desktop\Orders\" & DayId & "\Batches"
      
      Set fso = CreateObject("Scripting.FileSystemObject")
      Set StartFldr = fso.GetFolder(StartPth)
      Call RecursiveFolder(fso, StartFldr, True)
   End If
End Sub

Sub figures()

   Dim fso As Object, StartFldr As Object
   Dim StartPth As String, DayId As String
 
   DayId = Range("B1").Value
   StartPth = "C:\Users\Lisap\OneDrive\Desktop\Orders\" & DayId & "\Batches"
 
   Set fso = CreateObject("Scripting.FileSystemObject")
   Set StartFldr = fso.GetFolder(StartPth)
   Call RecursiveFolder(fso, StartFldr, True)


End Sub
Sub figures()

Sub RecursiveFolder(fso As Object, Fldr As Object, IncludeSubFolders As Boolean)
   Dim FldrFile As Object
   Dim SubFldr As Object
   Dim NxtRw As Long
 
   Range("B2") = Range("B2") + Fldr.Files.Count
 
   If IncludeSubFolders Then
      For Each SubFldr In Fldr.SubFolders
         Call RecursiveFolder(fso, SubFldr, True)
      Next SubFldr
   End If
End Sub

I know I am asking a lot of questions but I really wish I knew how to do this stuff as I find it very interesting and learning from books and what information and knowledge I can gather from here (you), which is why I appreciate it a lot and I don't want to take up much of your time.

Thank you,
Lisa

 

[Fluff]

This is the 1st time you have made any mention of counting files in multiple different locations.
Delete all that code & use

Private Sub Worksheet_Change(ByVal Target As Range)
   Dim fso As Object, StartFldr As Object
   Dim StartPth As String, DayId As String
   If Target.CountLarge > 1 Then Exit Sub
   If Target.Address(0, 0) = "B1" Then
      DayId = Range("B1").Value
      StartPth = "C:\Users\Lisap\OneDrive\Desktop\Orders\" & DayId & "\Batches"
      
      Set fso = CreateObject("Scripting.FileSystemObject")
      Set StartFldr = fso.GetFolder(StartPth)
      Call RecursiveFolder(fso, StartFldr, True)
   End If
End Sub

Sub RecursiveFolder(fso As Object, Fldr As Object, IncludeSubFolders As Boolean)
   Dim FldrFile As Object
   Dim SubFldr As Object
   Dim NxtRw As Long
 
   Range("B2") = Range("B2") + Fldr.Files.Count
 
   If IncludeSubFolders Then
      For Each SubFldr In Fldr.SubFolders
         Call RecursiveFolder(fso, SubFldr, True)
      Next SubFldr
   End If
End Sub

 

[LisaLou]

Thank you, that is working exactly how I want!

Do I just need to copy and paste the code and just change cell B2 to B3 and the folder location to count all the files I want to?

 

[Fluff]

Are the values in A2 downwards the final part of the file path (ie instead of batches)?

 

[LisaLou]

Are the values in A2 downwards the final part of the file path (ie instead of batches)?

Yes, that is the final part up to A11.

Thanks.