VBA – recursionsearch文件夹并计算find的文件中的值

我想创build的是一些VBA，将recursion地通过一组文件夹（文件夹结构和文件可能会不时变化），并从每个文件列出他们没有扩展名。 然后，对于每个文件（它们本质上是清单），在一个范围（D6：H25）中的“Y”的数量计数，然后例如以60/100的计数着陆。 所以我希望最终能得到如下的电子表格。

DAVE 80 BEN 12 

我目前拥有的代码pipe理列出所有的文件名称，没有扩展名。

 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 

我没有pipe理如何在循环内的VBA中进行计数，我已经在Excel公式中完成了下面的内容，但是它正是我所需要的，然而在我想如何将它变成最小努力未来几乎没有人工干预。

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

任何帮助将不胜感激，谢谢

Answer 1

试试这个，它使用CMD.exe获取文件名列表（这比使用Dir()recursion更快），并使用文件信息评估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