首页 > 解决方案 > VBA - 使用日期搜索条件循环浏览网络位置上的多个子文件夹/提高搜索速度

问题描述

我的问题和 VBA 代码的目的:从网络目录中的每个“table.csv”文件中获取特定数据(几列)。每个 networkdirectory/subfolders01/subfolders02 包含一个“table.csv”文件,但每个 network/subfolders01 中还包含 100 个其他子文件夹。不需要其他文件夹,我们唯一感兴趣的是每个 subfolder01 的 subfolder02。网络目录中的子文件夹 01 的数量约为 15000。但是我只需要从 2020 年 1 月到 2020 年 4 月的子文件夹 01,例如(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'''

然后我有我的代码来从每个文件中获取传输数据。谢谢你。

标签: vbaloopsdatesubdirectory

解决方案


我将放入屏幕截图以清除 Get & Transform 方法,因为它是 GUI 方法而不是代码。

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

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

然后,您可以过滤路径。在您的情况下,它将基于文件夹名称中的日期。 在此处输入图像描述

现在它已被过滤,您可以使用标题按钮展开内容。 在此处输入图像描述

内部内容,您必须再次扩展才能从 csv 转换为 excel 表 在此处输入图像描述

根据需要选择/重命名列,然后点击“关闭并加载”将其放入 Excel。默认为新表,但如果需要更多自定义,您可以“加载到”。 在此处输入图像描述

这是你的输出。您可以根据需要右键单击刷新或从 vba 刷新。 在此处输入图像描述

编辑 - 刚刚注意到我使用 .txt 而不是 .csv 作为文件。可能会改变一两步在中间的样子,但总体思路是一样的。


推荐阅读