excel – VBA – Recursively search through folders and count values within the files found

What I’m trying to create is some VBA that will recursively go through a set of folders (Folder structure and files can change from time to time) and from each file list them without the extension. Then for each file (They are essentially checklists) count of the amount of “Y” in a range (D6:H25) which would then land we with a count of 60/100 for example. So I would hopefully end up with a spreadsheet like the below.

DAVE
80

BEN
12

The code that I currently have kind of manages listing all the file names and without the extension.

Sub Retrieve_File_listing()
Worksheets(1).Cells(2, 1).Activate
Call Enlist_Directories("<FILEPATH>", 1)
End Sub

Public Sub Enlist_Directories(Filepath As String, lngSheet As Long)
Dim strFldrList() As String
Dim lngArrayMax, x As Long

lngArrayMax = 0
Filename = Dir(Filepath & "*.*", 23)
While Filename <> ""
  If Filename <> "." And Filename <> ".." Then
If (GetAttr(Filepath & Filename) And vbDirectory) = vbDirectory Then
  lngArrayMax = lngArrayMax + 1
  ReDim Preserve strFldrList(lngArrayMax)
  strFldrList(lngArrayMax) = Filepath & Filename & "\"
Else

Filename = CreateObject("Scripting.FileSystemObject").GetBaseName(Filename)
ActiveCell.Value = Filename
Worksheets(lngSheet).Cells(ActiveCell.Row + 2, 1).Activate

  End If
 End If
 Filename = Dir()

Wend
If lngArrayMax <> 0 Then
   For x = 1 To lngArrayMax
    Call Enlist_Directories(strFldrList(x), lngSheet)
Next
End If
End Sub

I’ve not managed how to do the count in VBA within the loop, I’ve done the following within an Excel formula and it gets exactly what I need however doesn’t really work within how I want to make this into as minimal effort as possible in the future with little manual intervention.

=SUMPRODUCT(('<FILEPATH>[DAVE.xlsx]Sheet1'!$D$6:$H$25="Y")+ 0)

Any help would be appreciated, Thanks

Sub MM()

Const parentFolder  As String = "C:\Users\JoeBloggs\desktop\" '// NOTE trailing "\" is required
Dim i               As Long
Dim justFile        As String
Dim filePath        As String
Dim fileExt         As String

i = 1

For Each file In Filter(Split(CreateObject("WScript.Shell").Exec("CMD /C DIR """ & parentFolder & "*.*"" /S /B /A:-D").StdOut.ReadAll, vbCrLf), ".")

    justFile = Left(Mid$(file, InStrRev(file, "\") + 1), InStrRev(Mid$(file, InStrRev(file, "\") + 1), ".") - 1)
    filePath = Left$(file, InStrRev(file, "\"))
    fileExt = Mid$(file, InStrRev(file, "."))

    Cells(i, 1).value = justFile
    Cells(i + 1, 1).Formula = "=SUMPRODUCT(('" & filePath & "[" & justFile & fileExt & "]!Sheet1'$D$6:$H$25=""Y"")+0)"
    Cells(i + 1, 1).value = Cells(i + 1, 1).value

    i = i + 2

Next

End Sub

Tags: excelexcel, file, search, vba