使用VBA按部分文件名搜索复制PDF文件执行失败问题咨询

问题根源 #

• Scripting.FileSystemObject的FileExists方法不支持通配符（*）匹配，你传入带*的路径时，它会将*识别为文件名的实际字符，自然找不到对应文件，所以判断条件永远不成立。
• 原代码重复实例化FileSystemObject，属于冗余操作，会额外消耗系统资源。

修正后可运行代码 #

Sub copyFile1()
    Dim objFSO As Object, rng As Range
    Dim strOldPath As String, strNewPath As String
    Dim strPrefix As String, strMatchFile As String
    
    ' 只实例化一次FSO，放在循环外减少资源消耗
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    strOldPath = "C:\Users\Desktop\Source\" ' 末尾加斜杠避免路径拼接出错
    strNewPath = "C:\Users\Desktop\Destination\"
    
    ' 提前校验文件夹存在性，避免路径配置错误导致运行报错
    If Not objFSO.FolderExists(strOldPath) Or Not objFSO.FolderExists(strNewPath) Then
        MsgBox "源文件夹或目标文件夹不存在，请检查路径配置"
        Exit Sub
    End If
    
    For Each rng In ActiveSheet.Range("A1:A2")
        strPrefix = Trim(rng.Value)
        If strPrefix = "" Then GoTo NextRng ' 跳过空单元格
        
        ' 用支持通配符的Dir函数匹配对应前缀的PDF文件
        strMatchFile = Dir(strOldPath & strPrefix & "*.pdf")
        Do While strMatchFile <> ""
            ' 执行复制，第三个参数为True表示目标路径有同名文件时直接覆盖
            objFSO.CopyFile strOldPath & strMatchFile, strNewPath & strMatchFile, True
            strMatchFile = Dir ' 查找下一个匹配文件，适配同前缀多文件的场景
        Loop
NextRng:
    Next
    
    Set objFSO = Nothing
    MsgBox "文件复制操作完成"
End Sub

关键修改说明 #

• 用支持通配符的Dir函数替代FileExists做文件匹配，可正确识别test1*.pdf格式的前缀匹配规则
• 新增文件夹存在性校验，避免路径配置错误导致的运行报错
• 新增空单元格跳过逻辑，适配单元格内容为空的场景
• 支持同前缀多个文件的批量复制，不会只复制第一个匹配到的文件
• 复制操作新增覆盖参数，避免目标路径已有同名文件时抛出异常

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