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.
Any help would be appreciated, Thanks
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 Next End Sub