求助：基于命名范围PO#列表筛选文件夹匹配PDF文件的VBA代码

需求背景 #

自学VBA过程中遇到瓶颈，核心需求是：以命名范围中的PO#列表作为部分匹配条件，在PO文件夹中找到对应的PDF文件，最终要复制到其他文件夹。目前先做导出匹配文件的文件名和路径，但文件夹有10800+文件且持续增长，全量导出效率太低，需要添加筛选逻辑。

遇到的问题 #

• 无法正确引用OneDrive中工作簿「C:\Users\Anthony\OneDrive - CompanyName\Automated parts label template.xlsm」的命名范围POtomatch
• 使用Like运算符匹配范围对象时出现类型不匹配错误，不确定Like能否直接用于范围对象
• 现有代码逻辑错误，导致筛选无效

尝试过的代码 #

更新后的代码（存在类型不匹配错误） #

Sub Full_file_path_copy_paste()

Dim objFSO As Scripting.FileSystemObject
Dim objfolder As Scripting.Folder
Dim objfile As Scripting.file
Dim nextrow As Long

Dim POlist As Range
Dim POnum As Variant 'I get a type mismatch error when setting POnum, not sure what type I should put here to get the values from the range in a format that can be used for matching...

'set the list of PO numbers as the range containing the search terms'
Set POlist = Range("POtomatch")
Set POnum = POlist.Value

Set objFSO = CreateObject("scripting.filesystemobject")
Set objfolder = objFSO.GetFolder("C:\Users\Anthony\SynologyDrive\@PO")

nextrow = Cells(Rows.Count, 6).End(xlUp).Row + 1
If objfile Like POnum Then
    For Each objfile In objfolder.Files
        Cells(nextrow, 6) = objfile.Name
        Cells(nextrow, 7) = objfile.Path
        nextrow = nextrow + 1
Next

当前代码（引用命名范围错误） #

Sub Full_file_path_copy_paste()

Dim objFSO As Scripting.FileSystemObject
Dim objfolder As Scripting.Folder
Dim objfile As Scripting.file
Dim nextrow As Long

'here is where I've been attempting to include a search/match/filter function'

'return value will be the values on the list of search terms from the named array on an input table'
Dim ReturnValue As Object
'Named array containing the search criteria list'
Set ReturnValue = Workbooks("POtomatch")

Set objFSO = CreateObject("scripting.filesystemobject")
Set objfolder = objFSO.GetFolder("C:\Users\Anthony\SynologyDrive\@PO")

nextrow = Cells(Rows.Count, 6).End(xlUp).Row + 1
If objfile Like ReturnValue Then
For Each objfile In objfolder.Files
    Cells(nextrow, 6) = objfile.Name
    Cells(nextrow, 7) = objfile.Path
    nextrow = nextrow + 1
Next
End If

End Sub

解决方案 #

步骤1：正确引用OneDrive中的命名范围 #

要准确引用外部工作簿的命名范围，需先打开该工作簿（或确保其已打开），然后通过Workbooks("文件名").Range("命名范围")获取：

Dim wbPO As Workbook
Set wbPO = Workbooks.Open("C:\Users\Anthony\OneDrive - CompanyName\Automated parts label template.xlsm")
Dim POlist As Range
Set POlist = wbPO.Range("POtomatch")

步骤2：将PO#列表转为数组提升匹配效率 #

把范围值存入数组，避免每次循环都访问工作表，提升处理速度：

Dim POarray As Variant
POarray = POlist.Value

步骤3：修正Like匹配逻辑，遍历文件时逐一检查 #

Like只能用于字符串匹配，需遍历每个PO#，检查文件名是否包含该PO#：

Sub FilterPOFiles()
    Dim objFSO As Scripting.FileSystemObject
    Dim objfolder As Scripting.Folder
    Dim objfile As Scripting.File
    Dim nextrow As Long
    Dim wbPO As Workbook
    Dim POlist As Range
    Dim POarray As Variant
    Dim i As Long
    Dim isMatch As Boolean
    
    ' 打开目标工作簿并获取PO列表
    Set wbPO = Workbooks.Open("C:\Users\Anthony\OneDrive - CompanyName\Automated parts label template.xlsm")
    Set POlist = wbPO.Range("POtomatch")
    POarray = POlist.Value
    
    ' 初始化FSO并指定目标文件夹
    Set objFSO = New Scripting.FileSystemObject
    Set objfolder = objFSO.GetFolder("C:\Users\Anthony\SynologyDrive\@PO")
    
    ' 获取输出起始行（替换为你的工作表名称）
    nextrow = ThisWorkbook.Sheets("Sheet1").Cells(Rows.Count, 6).End(xlUp).Row + 1
    
    ' 遍历文件夹中的所有文件
    For Each objfile In objfolder.Files
        ' 只处理PDF文件
        If LCase(objfile.Name) Like "*.pdf" Then
            isMatch = False
            ' 遍历PO数组检查匹配
            For i = 1 To UBound(POarray, 1)
                If Not IsEmpty(POarray(i, 1)) Then
                    If objfile.Name Like "*" & POarray(i, 1) & "*" Then
                        isMatch = True
                        Exit For ' 找到匹配就跳出PO循环，提升效率
                    End If
                End If
            Next i
            
            ' 如果匹配则写入工作表
            If isMatch Then
                ThisWorkbook.Sheets("Sheet1").Cells(nextrow, 6) = objfile.Name
                ThisWorkbook.Sheets("Sheet1").Cells(nextrow, 7) = objfile.Path
                nextrow = nextrow + 1
            End If
        End If
    Next objfile
    
    ' 关闭PO工作簿（可选，根据需求决定是否保存）
    wbPO.Close SaveChanges:=False
    ' 释放对象
    Set objFSO = Nothing
    Set objfolder = Nothing
    Set wbPO = Nothing
End Sub

关键说明 #

• 明确指定工作表：使用ThisWorkbook.Sheets("你的工作表名")避免激活其他工作表导致的错误
• 过滤PDF文件：通过LCase(objfile.Name) Like "*.pdf"只处理目标文件类型
• 提前退出循环：找到匹配的PO#后立即跳出内层循环，减少不必要的遍历
• 释放对象：最后手动释放所有对象变量，避免内存泄漏

内容的提问来源于stack exchange，提问作者Anthony Davis SF