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

时间:2016-05-23 11:20:22

标签: excel vba excel-vba

我尝试创建的是一些VBA,它将以递归方式通过一组文件夹(文件夹结构和文件可能会不时更改),并从每个文件列出它们而不使用扩展名。然后对于每个文件(它们本质上是清单)计算" Y"在一个范围(D6:H25)中,然后以例如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)

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

1 个答案:

答案 0 :(得分:2)

尝试使用它,它使用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