如何用VBA的Like表达式在多文件夹搜索匹配PDF并复制到目标路径

原代码核心问题 #

• 匹配逻辑倒置：原代码判断未赋值的strFileToCopy是否符合单元格规则，匹配分支永远无法触发
• 未实现前缀模糊匹配：仅拼接关键词加.pdf后缀，只能匹配完全同名文件，无法覆盖前缀一致的目标文件
• 仅遍历了第一个搜索文件夹，未覆盖另外两个配置的搜索路径
• 循环内重复创建FileSystemObject对象，存在不必要的性能开销
• 没有遍历文件夹下所有文件做匹配判断，仅检查固定文件名是否存在

修复后可直接使用的代码 #

Sub copyMatchedPDFs()
    Dim objFSO As Object
    Dim searchFolders As Variant, folderPath As Variant
    Dim keywordRng As Range, keyword As String
    Dim targetFolder As Object, file As Object
    Dim strNewPath As String
    
    ' --------------------------配置参数区 按需修改--------------------------
    ' 三个搜索文件夹完整路径，路径末尾不需要加反斜杠
    searchFolders = Array( _
        "C:\第一个搜索文件夹的完整路径", _
        "C:\第二个搜索文件夹的完整路径", _
        "C:\第三个搜索文件夹的完整路径" _
    )
    ' 文件复制的目标存储文件夹完整路径
    strNewPath = "C:\目标存储文件夹的完整路径"
    ' ----------------------------------------------------------------------
    
    ' 初始化文件系统对象
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    ' 目标路径不存在则自动创建
    If Not objFSO.FolderExists(strNewPath) Then
        objFSO.CreateFolder strNewPath
    End If
    
    ' 遍历A1:A2单元格的所有搜索关键词
    For Each keywordRng In ActiveSheet.Range("A1:A2")
        keyword = Trim(keywordRng.Value)
        ' 跳过空单元格避免匹配所有PDF
        If keyword <> "" Then
            ' 遍历所有搜索文件夹
            For Each folderPath In searchFolders
                ' 跳过不存在的无效搜索路径
                If objFSO.FolderExists(folderPath) Then
                    Set targetFolder = objFSO.GetFolder(folderPath)
                    ' 遍历当前文件夹下所有文件做匹配
                    For Each file In targetFolder.Files
                        ' 匹配规则：文件名以关键词开头、后缀为PDF，不区分大小写
                        If UCase(file.Name) Like UCase(keyword) & "*.pdf" Then
                            ' 复制文件，第三个参数为True时重名自动覆盖，为False时跳过重名文件
                            objFSO.CopyFile file.Path, objFSO.BuildPath(strNewPath, file.Name), True
                        End If
                    Next file
                End If
            Next folderPath
        End If
    Next keywordRng
    
    ' 释放对象资源
    Set objFSO = Nothing
    Set targetFolder = Nothing
    MsgBox "PDF文件搜索复制操作完成！", vbInformation
End Sub

使用说明 #

1. 先修改代码中配置参数区的三个搜索路径和目标存储路径，确保路径为本地完整路径
2. 如果不需要覆盖目标路径下的重名文件，将objFSO.CopyFile的第三个参数改为False即可
3. 打开存储关键词的工作表，运行宏即可自动完成匹配搜索和文件复制

内容的提问来源于stack exchange，提问作者Xiamao Vu