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

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

Posted by: admin April 23, 2020 Leave a comment


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.



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 & "\"

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

  End If
 End If
 Filename = Dir()

If lngArrayMax <> 0 Then
   For x = 1 To lngArrayMax
    Call Enlist_Directories(strFldrList(x), lngSheet)
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

How to&Answers:

Try this instead, it uses CMD.exe to fetch a list of file names (which is quicker than recursion with Dir() ) and evaluates the SUMPRODUCT formula using the file information:

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


End Sub