VBA - 递归搜索文件夹并计算找到的文件中的值

Question

我试图创建的是一些 VBA，它将递归地遍历一组文件夹(文件夹结构和文件可能会不时更改)，并从每个文件中列出它们，而无需扩展名。然后，对于每个文件(它们本质上是 list )，计算范围 (D6:H25) 中“Y”的数量，例如，我们的计数将为 60/100。所以我希望最终能得到如下所示的电子表格。

DAVE
80

BEN
12

我目前拥有的代码管理列出所有文件名且不带扩展名。

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

我还没有设法在循环内用VBA进行计数，我已经在Excel公式中完成了以下操作，它完全满足了我的需要，但并没有真正按照我想要的方式工作将来尽可能减少工作量，几乎不需要人工干预。

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

如有任何帮助，我们将不胜感激，谢谢

Answer 1

试试这个，它使用 CMD.exe 获取文件名列表(这比使用 Dir() 进行递归更快)并使用以下方法计算 SUMPRODUCT 公式:文件信息:

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