VBA-使用日期搜索条件在网络位置上遍历多个子文件夹/提高搜索速度

Posted 2021-04-28

出于我的问题和VBA代码的目的：从网络目录中的每个“ table.csv”文件中获取特定数据（几列）。每个网络目录/子文件夹01 /子文件夹02都包含一个“ table.csv”文件，但每个网络/子文件夹01中还包含100个其他子文件夹。不需要其他文件夹，我们唯一感兴趣的是每个subfolder01的subfolder02。网络目录中subfolders01的数量约为15000。但是，例如，我仅需要从2020年1月到2020年4月的subfolders01（200个子文件夹）。最终目的是趋势数据。

问题：我试图了解如何改善当前使用的VBA代码。此代码一个接一个地遍历每个子文件夹，然后检查日期和文件名。我想知道是否有一种方法可以为子文件夹的日期和名称添加任何搜索过滤条件，以加快循环速度。我们如何避免代码遍历每个子文件夹？

[请在下面查看我正在使用的代码，非常感谢您的宝贵时间，并希望我的要求清楚。

'''

Function GetFiles(startPath As String) As Collection 
Dim fso As Object, rv As New Collection, colFolders As New Collection, fpath As String
Dim subFolder As Object, f, dMinfold, dtMod
Set fso = CreateObject("Scripting.FileSystemObject")

dMinfold = ThisWorkbook.Sheets("Enter_Date").Cells(2, 1)

colFolders.Add startPath

Do While colFolders.Count > 0
    fpath = colFolders(1)
    colFolders.Remove 1
    'process subfolders
    For Each subFolder In fso.getfolder(fpath).subfolders
        If subFolder.DateLastModified >= dMinfold Then
            colFolders.Add subFolder.Path
        End If
    Next subFolder
    'process files
    f = Dir(fso.buildpath(fpath, "*Table.csv"), vbNormal)
    Do While f <> ""
        f = fso.buildpath(fpath, f)
        dtMod = FileDateTime(f)
        If dtMod >= dMinfold And Right(f, 3) = "csv" Then
            rv.Add f
        End If

        f = Dir()
    Loop
Loop
Set GetFiles = rv
End Function'''

然后，我有了我的代码，可以从每个文件中获取传输数据。谢谢。

答案

我将在屏幕截图中清除Get＆Transform方法，因为它是GUI方法而不是代码。

可以在加载内容之前进行过滤，这将大大加快速度。我尝试了将数千个子文件夹过滤到20个，并立即加载。

这是从文件夹获取数据的初始屏幕

然后您可以过滤路径。在您的情况下，它将基于文件夹名称中的日期。

现在已过滤，您可以使用标题按钮展开内容。

内部内容，您必须再次扩展才能从csv转换为excel表

根据需要选择/重命名列，然后单击“关闭并加载”以将其放入excel。默认值为新表，但是如果需要更多自定义内容，则可以“加载到”。

这是您的输出。您可以根据需要右键单击刷新或从vba刷新。