递归尝试使用关键字（VBA-Access）在文件夹中查找文件

Question

我正在创建一个带有下拉框 Combo_History 的 vba-access 应用程序，它使用户能够从名为“扫描的工作订单（档案）”的主文件夹中的子文件夹中启动 .pdf 文件。我想要做的是使用一个称为“M”号的特定数字（M 号，因为每个数字都以 M 开头：M765196）在不使用特定子文件夹的情况下找到这个文件，这是我到目前为止所拥有的：

---

Dim fso, oFolder, oSubfolder, oFile, queue As Collection

Set fso = CreateObject("Scripting.FileSystemObject")
Set queue = New Collection
queue.Add fso.GetFolder("T:\Scanned Work Orders (Archives)") 

Do While queue.Count > 0
    Set oFolder = queue(1)
    queue.Remove 1 'dequeue
    If oFile = Combo_History.Value Then
            Application.FollowHyperlink ("T:\Scanned Work Orders (Archives)" & oFile)

        End If
    For Each oSubfolder In oFolder.SubFolders
        queue.Add oSubfolder 'enqueue
    Next oSubfolder
    For Each oFile In oFolder.Files
        If oFile = Combo_History.Value Then
            Application.FollowHyperlink ("T:\Scanned Work Orders (Archives)" & oFile)

        End If
    Next oFile
Loop

问题是它陷入了无限循环，因为它无法找到关键字名称为 M765196 的 .pdf，即使它位于该文件夹中。我有什么遗漏吗？还是找到 .pdf 文件的更简单方法？

Answer 1

我想为 PeterT 的解决方案做出贡献（第二个答案）！看来我没有足够的积分来发表评论，所以我将其发布为答案。

我测试了这个解决方案，它可以工作，但它有一些（小）错误！我没有在具有复杂权限的服务器上测试它，但我最终必须在不久的将来这样做！

• 如果 startFolder 为空（没有文件，但有子文件夹），该函数不会继续在 startFolders 的子文件夹中搜索。
• 搜索 A*.pdf 和 a*.PDF 不会给出相同的结果。鉴于 Windows 文件系统不区分大小写，因此明智的做法是进行不区分大小写的搜索。也许它不适用于 MAC？！

此外，我添加了两个（可选）额外参数，垃圾收集代码和 FSO 对象的早期绑定（我更喜欢！）：

• boolean subFolders - 如果为 false，该函数将不会搜索超出 开始文件夹
• boolean fullPath - 如果为 false，函数将只返回不带路径的文件名；有用（至少对我而言），尤其是在 subFolders=false 时。
• 搜索完成后 (recurseDepth = 0) 所有对象都设置为 Nothing。

代码如下：

Public Function FindFiles( _
    ByVal startFolder As String, _
    ByVal fileSpec As String, _
    ByRef fileList() As String, _
    Optional ByVal subFolders As Boolean = True, _
    Optional ByVal fullPath As Boolean = True) _
  As Long
    '--- starts in the given folder and checks all files against the filespec.
    '    the filespec MAY HAVE A WILDCARD specified, so the function returns
    '    an array of files with or withour full pathnames (strings) to each file that matches
    '      Parameters:  startFolder - string containing a full path to the root
    '                                folder for the search
    '                   fileSpec   - string containing a single filename to
    '                                search for, --or--
    '                                string containing a wildcard string of
    '                                files to search for
    '        (result==>)fileList   - an array of strings, each will be a full
    '                                path to a file matching the input filespec
    '                   subFolders - include subfolders in startFolder
    '                   fullPath   - true=>fullFile path; false=>fileName only
    '         Returns:  (integer) count of the files found that match the filespec

    Dim fullFilePath As String
    Dim Path As String

    Static fso As FileSystemObject
    Static pathCollection As Collection
    Dim oFile As file
    Dim oFolder As Folder
    Dim oSubfolder As Folder

    On Error GoTo Error_FindFile

    '--- first time through, set up the working objects
    If recurseDepth = 0 Then
        Set fso = New FileSystemObject ' CreateObject("Scripting.FileSystemObject")
        Set pathCollection = New Collection
    End If
    recurseDepth = recurseDepth + 1

    '--- focus on the given folder
    Set oFolder = fso.GetFolder(startFolder)

    '--- first test if we have permissions to access the folder and
    '    if there are any files in the folder
    On Error Resume Next
    If oFolder.files.Count > 0 Or oFolder.subFolders.Count > 0 Then
        If Err.Number = 0 Then
            '--- loop through all items in the folder. some are files and
            '    some are folders -- use recursion to search the subfolders
            If fullPath Then
              Path = oFolder.Path & "\"
            Else
              Path = ""
            End If
            For Each oFile In oFolder.files
'              If oFile.name Like fileSpec Then
              If LCase(oFile.name) Like LCase(fileSpec) Then
                pathCollection.Add Path & oFile.name
              End If
            Next oFile
            If subFolders Then
              For Each oSubfolder In oFolder.subFolders
                FindFiles oSubfolder.Path, fileSpec, fileList, subFolders, fullPath
              Next oSubfolder
            End If
        Else
            '--- if we get here it's usually a permissions error, so
            '    just skip this folder
            Err.Clear
        End If
    End If
    On Error GoTo Error_FindFile

Exit_FindFile:
    recurseDepth = recurseDepth - 1
    If (recurseDepth = 0) Then
      If (pathCollection.Count > 0) Then
        '--- pull the paths out of the collection and make an array, because most
        '    programs uses arrays more easily
        ReDim fileList(1 To pathCollection.Count)
        Dim i As Integer
        For i = 1 To pathCollection.Count
            fileList(i) = pathCollection.Item(i)
        Next i
      End If
      FindFiles = pathCollection.Count
      Set fso = Nothing
      Set pathCollection = Nothing
      Set oFile = Nothing
      Set oFolder = Nothing
      Set oSubfolder = Nothing
    End If
    Exit Function
Error_FindFile:
    Debug.Print "Error (" & Err.Number & "): " & Err.Description & _
                        " on " & oSubfolder.Path
    GoTo Exit_FindFile
End Function

Answer 2

This page 建议使用以下递归查找通配符的技术：

Sub Macro1()
    Dim colFiles As New Collection
    RecursiveDir colFiles, "C:\Photos\", "*.jpg", True

    Dim vFile As Variant
    For Each vFile In colFiles
        Debug.Print vFile
    Next vFile
End Sub

Public Function RecursiveDir(colFiles As Collection, _
                             strFolder As String, _
                             strFileSpec As String, _
                             bIncludeSubfolders As Boolean)

    Dim strTemp As String
    Dim colFolders As New Collection
    Dim vFolderName As Variant

    'Add files in strFolder matching strFileSpec to colFiles
    strFolder = TrailingSlash(strFolder)
    strTemp = Dir(strFolder & strFileSpec)
    Do While strTemp <> vbNullString
        colFiles.Add strFolder & strTemp
        strTemp = Dir
    Loop

    If bIncludeSubfolders Then
        'Fill colFolders with list of subdirectories of strFolder
        strTemp = Dir(strFolder, vbDirectory)
        Do While strTemp <> vbNullString
            If (strTemp <> ".") And (strTemp <> "..") Then
                If (GetAttr(strFolder & strTemp) And vbDirectory) <> 0 Then
                    colFolders.Add strTemp
                End If
            End If
            strTemp = Dir
        Loop

        'Call RecursiveDir for each subfolder in colFolders
        For Each vFolderName In colFolders
            Call RecursiveDir(colFiles, strFolder & vFolderName, strFileSpec, True)
        Next vFolderName
    End If

End Function

Public Function TrailingSlash(strFolder As String) As String
    If Len(strFolder) > 0 Then
        If Right(strFolder, 1) = "\" Then
            TrailingSlash = strFolder
        Else
            TrailingSlash = strFolder & "\"
        End If
    End If
End Function

Answer 3

我在这里添加第二个答案，因为解决通配符的问题比我预期的要大。

使用通配符搜索文件并不困难，但它会带来一些影响，例如返回结果列表而不是单个结果。此外，幸运的是，我在其中一个子文件夹上遇到了权限错误，这让我开始思考如何处理这种情况。

Option Explicit

Private recurseDepth As Integer

Sub test()
    Dim rootFolder As String
    Dim filename As String
    Dim resultFiles() As String
    Dim i As Integer

    rootFolder = "C:\Temp"
    filename = "*.pdf"

    If FindFiles(rootFolder, filename, resultFiles) > 0 Then
        For i = 1 To UBound(resultFiles)
            Debug.Print Format(i, "00") & ": " & resultFiles(i)
        Next i
    Else
        Debug.Print "No files found!"
    End If
End Sub

Public Function FindFiles(thisFolder As String, filespec As String, _
                          ByRef fileList() As String) As Integer
    '--- starts in the given folder and checks all files against the filespec.
    '    the filespec MAY HAVE A WILDCARD specified, so the function returns
    '    an array of full pathnames (strings) to each file that matches
    '      Parameters:  thisFolder - string containing a full path to the root
    '                                folder for the search
    '                   filespec   - string containing a single filename to
    '                                search for, --or--
    '                                string containing a wildcard string of
    '                                files to search for
    '        (result==>)fileList   - an array of strings, each will be a full
    '                                path to a file matching the input filespec
    '         Returns:  (integer) count of the files found that match the filespec
    On Error GoTo Error_FindFile
    Static fso As Object
    Static pathCollection As Collection
    Dim fullFilePath As String
    Dim oFile As Object
    Dim oFolder As Object
    Dim oSubfolder As Object

    '--- first time through, set up the working objects
    If recurseDepth = 0 Then
        Set fso = CreateObject("Scripting.FileSystemObject")
        Set pathCollection = New Collection
    End If
    recurseDepth = recurseDepth + 1

    '--- focus on the given folder
    Set oFolder = fso.GetFolder(thisFolder)

    '--- first test if we have permissions to access the folder and
    '    if there are any files in the folder
    On Error Resume Next
    If oFolder.Files.Count > 0 Then
        If Err.Number = 0 Then
            '--- loop through all items in the folder. some are files and
            '    some are folders -- use recursion to search the subfolders
            For Each oFile In oFolder.Files
                If oFile.Name Like filespec Then
                    pathCollection.Add oFolder.Path & "\" & oFile.Name
                End If
            Next oFile
            For Each oSubfolder In oFolder.SubFolders
                FindFiles oSubfolder.Path, filespec, fileList
            Next oSubfolder
        Else
            '--- if we get here it's usually a permissions error, so
            '    just skip this folder
            Err.Clear
        End If
    End If
    On Error GoTo Error_FindFile

Exit_FindFile:
    recurseDepth = recurseDepth - 1
    If (recurseDepth = 0) And (pathCollection.Count > 0) Then
        '--- pull the paths out of the collection and make an array, because most
        '    programs uses arrays more easily
        ReDim fileList(1 To pathCollection.Count)
        Dim i As Integer
        For i = 1 To pathCollection.Count
            fileList(i) = pathCollection.Item(i)
        Next i
    End If
    FindFiles = pathCollection.Count
    Exit Function

Error_FindFile:
    Debug.Print "Error (" & Err.Number & "): " & Err.Description & _
                        " on " & oSubfolder.Path
    GoTo Exit_FindFile

End Function

Answer 4

您的循环设置不适合递归查找文件。下面的代码应该适合你。

此外，您正在为您的 FileSystemObjects 使用后期绑定 - 这非常好。但是您声明它们的方式会导致它们都被评估为变体。这可能很痛苦，但最好将每个变量 Dim 拆分为单独的行，并准确指定它应该是什么类型。

Option Explicit

Sub test()
    Dim fso As Object
    Dim rootFolder As String
    Dim filename As String
    Dim fullpath As String

    Set fso = CreateObject("Scripting.FileSystemObject")
    rootFolder = "C:\Users\user\Documents"
    filename = "testfile.txt"

    fullpath = FindFile(fso, rootFolder, filename)
    Debug.Print "file is ";
    If Len(fullpath) > 0 Then
        Debug.Print "FOUND! : " & fullpath
    Else
        Debug.Print "NOT found. Go look for it yourself!"
    End If
End Sub

Function FindFile(fso As Object, thisFolder As String, filename As String) As String
    On Error GoTo Error_FindFile
    Dim fullFilePath As String
    Dim oFolder As Object
    Dim oSubfolder As Object

    Set oFolder = fso.GetFolder(thisFolder)

    '--- first check if the file is in the current folder
    fullFilePath = oFolder.Path & "\" & filename
    If fso.FileExists(fullFilePath) Then
        '--- we're done, nothing more to do here
    Else
        '--- the file isn't in this folder, so check for any subfolders and search there
        fullFilePath = ""
        For Each oSubfolder In oFolder.SubFolders
            Debug.Print "looking in " & oSubfolder.Path
            If FindFile(fso, oSubfolder.Path, filename) <> "" Then
                '--- found the file, so return the full path
                fullFilePath = oSubfolder.Path & "\" & filename
                Exit For
            End If
        Next oSubfolder
    End If

Exit_FindFile:
    FindFile = fullFilePath
    Exit Function

Error_FindFile:
    '--- we'll probably get mostly permission errors, so just skip (or log, or print out)
    '    the permission error and move on
    If Err.Number = 70 Then
        Debug.Print "Permission error on " & oSubfolder.Path
    End If
    GoTo Exit_FindFile

End Function