Question

我需要有关在VBA中使用DIR功能实现过滤器以加速文件搜索的帮助。

上下文： 我有合同夹。有些合同直接在上面，有些则在单独的“类别”子文件夹中。所以看起来像这样：

在每个合同文件夹中，我需要找到一个文件，其名称包含“ RENS_RES”，位于“ 2000 * \ 2300 * \”中。我需要获取该文件的路径

情况： 该功能有效。但这很慢，因为所有内容都在服务器上，并且有很多文件夹/子文件夹/文件要经过，并且会对其全部进行测试。最多可能需要15分钟。

所以我想使其更快。

现在，我有一个看起来像这样的代码：

Dim fso 'As New FileSystemObject
Dim fld 'As Folder
Public tampon(120) As Variant 'Where I stock my selected files path
sFol = "C:\something\" The path to my main folder, that contains everything, created as String
sFile = "*RENS_RES*.xlsx" 'The criteria to determine the files to select, created as String
Function FindFile(ByVal sFol As String, sFile As String) As String 'Arguments initially from somewhere else specified
'initially called somewhere else

 Dim tFld, tFil as String 'The currently selected folder and file
 Dim FileName As String  'FileName the name of the selected file

 Set fso = CreateObject("Scripting.FileSystemObject")
 Set fld = fso.GetFolder(sFol)
 FileName = Dir(fso.BuildPath(fld.path, sFile), vbNormal Or _
              vbHidden Or vbSystem Or vbReadOnly) 'I search the first file respecting the criteria sFile
 While Len(FileName) <> 0 'I keep going until all files int he folder are tested
  FindFile = FindFile + FileLen(fso.BuildPath(fld.path, _
  FileName))
  tampon(i) = fso.BuildPath(fld.path, FileName) 'We save the value
  i = i + 1
  FileName = Dir()  ' Get next file
  DoEvents
 Wend

 If fld.SubFolders.Count > 0 Then 'If the current folder has subfolders
  For Each tFld In fld.SubFolders 'We consider each subfolder
    If Not (tFld.Name Like "#000*") Or tFld.Name Like "2000*" Or tFld.Name Like "2300*" Then ' We exclude all the subfolders that start with 4 numbers (format x000) and are not 2000 or 2300 from the search
        DoEvents
        FindFile = FindFile + FindFile(tFld.path, sFile) 'We call again the function to test all files in that subfolder
    End If
  Next
 End If
 Exit Function
Catch:  FileName = ""
   Resume Next
End Function

我试图在子文件夹选择中放置一个过滤器：

If Not (tFld.Name Like "#000*") Or tFld.Name Like "2000*" Or tFld.Name Like "2300*" Then

它具有相反的逻辑，因为它可以模拟“针对每个循环”中的退出。

理论上，如果名称以4位数字开头（一个数字后跟三个零，而不是“ 2000 *”或“ 2300 *”（我们要放入的两个文件夹），则不应输入“ if”。我之所以这样，是因为类别或合同名称中没有可用于过滤器的逻辑。

但是过滤器不起作用：它不断遍历每个文件夹，我也不知道为什么。那就是我寻求帮助的地方。

还是有另一种方法可以更快地进行搜索？

预先感谢您的帮助，希望我能格式化代码

Answer 1

如果找到这种非递归方法来查找匹配项，则更易于推理/修改：

'Return a collection of file objects given a starting folder and a file pattern
'  e.g. "*.txt"
'Pass False for last parameter if don't want to check subfolders
Function GetMatches(startFolder As String, filePattern As String, _
                    Optional subFolders As Boolean = True) As Collection

    Dim fso, fldr, f, subFldr
    Dim colFiles As New Collection
    Dim colSub As New Collection

    Set fso = CreateObject("scripting.filesystemobject")
    colSub.Add startFolder

    Do While colSub.Count > 0

        Set fldr = fso.getfolder(colSub(1))
        colSub.Remove 1

        For Each f In fldr.Files
            'check filename pattern
            If UCase(f.Name) Like UCase(filePattern) Then colFiles.Add f
        Next f

        If subFolders Then
            For Each subFldr In fldr.subFolders
                'check subfolder criteria
                'another attempt at your logic...
                If subFldr.Name Like "2000*" or Not subFldr.Name Like "#000*" Then
                    colSub.Add subFldr.Path
                End If
            Next subFldr
        End If

    Loop

    Set GetMatches = colFiles

End Function

用法示例：

Dim colFiles as Collection
Set colFiles = GetMatches("C:\something\", ""*RENS_RES*.xlsx"")

VBA-将文件夹名称过滤器添加到递归DIR搜索

1 个答案: