反复尝试使用关键字（VBA Access）查找文件夹中的文件_Vba_Recursion_Directory

反复尝试使用关键字（VBA Access）查找文件夹中的文件

vba recursion directory

反复尝试使用关键字（VBA Access）查找文件夹中的文件,vba,recursion,directory,Vba,Recursion,Directory,我正在创建一个vba access应用程序，该应用程序带有一个下拉框组合历史记录，使用户能够从名为“扫描工单（归档）”的主文件夹中的子文件夹启动.pdf文件。我想做的是使用一个称为“M”号的特定数字（M号，因为每个数字都以M ex:M765196开头）来查找此文件，而不使用特定的子文件夹。到目前为止，我有： Dim fso、oFolder、oSubfolder、oFile、队列作为集合 Set fso = CreateObject("Scripting.FileSystemObject") S

我正在创建一个vba access应用程序，该应用程序带有一个下拉框组合历史记录，使用户能够从名为“扫描工单（归档）”的主文件夹中的子文件夹启动.pdf文件。我想做的是使用一个称为“M”号的特定数字（M号，因为每个数字都以M ex:M765196开头）来查找此文件，而不使用特定的子文件夹。到目前为止，我有：

Dim fso、oFolder、oSubfolder、oFile、队列作为集合

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文件？

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

另外，您正在为文件系统对象使用后期绑定，这是非常好的。但是声明它们的方式会导致它们都作为变量进行计算。这可能是一件痛苦的事情，但最好将每个变量

Dim

作为单独的行分开，并准确地指定它应该是什么类型

选项显式
子测试（）
作为对象的Dim fso
将根文件夹设置为字符串
将文件名设置为字符串
将完整路径设置为字符串
设置fso=CreateObject（“Scripting.FileSystemObject”）
rootFolder=“C:\Users\user\Documents”
filename=“testfile.txt”
fullpath=FindFile（fso、根文件夹、文件名）
打印“文件是”；
如果Len（完整路径）>0，则
Debug.Print“FOUND！：”&完整路径
其他的
Debug.Print“找不到。自己去找吧！”
如果结束
端接头
函数FindFile（fso作为对象，thisFolder作为字符串，filename作为字符串）作为字符串
On Error GoTo Error_FindFile
将fullFilePath设置为字符串
作为对象的文件夹的尺寸
将oSubfolder作为对象
文件夹集=fso.GetFolder（thisFolder）
“---首先检查文件是否在当前文件夹中
fullFilePath=oFolder.Path&“\”文件名
如果存在fso.filepath（fullFilePath），则
---我们完了，这里没什么可做的了
其他的
“---该文件不在此文件夹中，请检查所有子文件夹并在其中搜索
fullFilePath=“”
对于oFolder.SubFolders中的每个oSubfolder
Debug.Print“looking in”&oSubfolder.Path
如果FindFile（fso，oSubfolder.Path，filename）“，则
“---找到了文件，因此返回完整路径
fullFilePath=oSubfolder.Path&“\”文件名
退出
如果结束
下一个oSubfolder
如果结束
退出查找文件：
FindFile=fullFilePath
退出功能
错误\u查找文件：
“---我们可能会收到大部分权限错误，因此只需跳过（或记录，或打印）
'权限错误并继续
如果错误编号=70，则
Debug.Print“权限错误”&oSubfolder.Path
如果结束
转到出口_FindFile
端函数

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

Dim

作为单独的行分开，并准确地指定它应该是什么类型

选项显式
子测试（）
作为对象的Dim fso
将根文件夹设置为字符串
将文件名设置为字符串
将完整路径设置为字符串
设置fso=CreateObject（“Scripting.FileSystemObject”）
rootFolder=“C:\Users\user\Documents”
filename=“testfile.txt”
fullpath=FindFile（fso、根文件夹、文件名）
打印“文件是”；
如果Len（完整路径）>0，则
Debug.Print“FOUND！：”&完整路径
其他的
Debug.Print“找不到。自己去找吧！”
如果结束
端接头
函数FindFile（fso作为对象，thisFolder作为字符串，filename作为字符串）作为字符串
On Error GoTo Error_FindFile
将fullFilePath设置为字符串
作为对象的文件夹的尺寸
将oSubfolder作为对象
文件夹集=fso.GetFolder（thisFolder）
“---首先检查文件是否在当前文件夹中
fullFilePath=oFolder.Path&“\”文件名
如果存在fso.filepath（fullFilePath），则
---我们完了，这里没什么可做的了
其他的
“---该文件不在此文件夹中，请检查所有子文件夹并在其中搜索
fullFilePath=“”
对于oFolder.SubFolders中的每个oSubfolder
Debug.Print“looking in”&oSubfolder.Path
如果FindFile（fso，oSubfolder.Path，filename）“，则
“---找到了文件，因此返回完整路径
fullFilePath=oSubfolder.Path&“\”文件名
退出
如果结束
下一个oSubfolder
如果结束
退出查找文件：
FindFile=fullFilePath
退出功能
错误\u查找文件：
“---我们可能会收到大部分权限错误，因此只需跳过（或记录，或打印）
'权限错误并继续
如果错误编号=70，则
Debug.Print“权限错误”&oSubfolder.Path
如果结束
转到出口_FindFile
端函数

我在这里添加了第二个答案，因为通配符的求解与原始答案的差异比我预期的要大

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

选项显式
Private recurseDepth作为整数
子测试（）
将根文件夹设置为字符串
将文件名设置为字符串
Dim resultFiles（）作为字符串
作为整数的Dim i
rootFolder=“C:\Temp”
filename=“*.pdf”
如果FindFile（根文件夹、文件名、结果文件）>0，则
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

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