excel 引用命名数组作为搜索条件以在文件夹中查找匹配的PDF文件

pftdvrlh  于 12个月前  发布在  其他
关注(0)|答案(1)|浏览(126)

你总觉得我是迷宫里的伊卡洛斯。三级玩家在百级迷宫中……我将开始理解我试图解决的问题的一个方面,只是让我找到的解决方案/资源包括我从未听说过的对代码功能至关重要的另一个方面。
我的总体目标是使用来自命名数组的PO#列表作为部分名称搜索条件,以查找PO#文件夹中的所有匹配文件并将其复制到单独的文件夹中。
到目前为止,我已经尝试修改别人的代码,以适应类似但略有不同的情况,当我无法将PO#列表作为搜索条件时,我放弃了。
我现在放弃了复制和粘贴文件,因为我是一个自学成才的初学者,可能缺乏FSO如何工作的大部分基础知识,但我计划使用复制的文件名和文件路径作为排序/复制粘贴的一种方式。所以我写了一段代码,把所有的文件名和路径从源文件夹复制粘贴到excel中,认为在那里排序会更容易。
不幸的是,该文件夹中有10,8XX个文件,并且每天都在增长,新文件越来越常用,因此每次重复此过程(每周多次)时都会提取每个文件名和路径有点太耗时了。
我希望有人能帮我添加一个过滤器/匹配/搜索功能,只返回文件名/路径匹配我的采购订单号列表。
我尝试使用“like”,然后使用命名列表作为like的条件,但我似乎不知道如何正确引用保存在onedrive上的工作簿来引用命名范围。我甚至不确定“喜欢”可以和范围tbh一起使用。“C:\Users\Anthony\OneDrive - CompanyName\Automated parts label template.xlsm”
更新代码:

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

一如既往,提前感谢您的耐心和帮助!

nvbavucw

nvbavucw1#

不能将LIKE用于值数组。使用|分隔符将它们连接在一起,以创建正则表达式的模式。

Option Explicit

Sub Full_file_path_copy_paste()

    Const POFOLDER = "C:\Users\Anthony\SynologyDrive\@PO"

    Dim objFSO As Object, objfolder As Object
    Dim objfile As Object, outputrow As Long
    Dim cel As Range
    Dim sPo As String, sPattern As String, sep As String
    Dim n As Long, i As Long, t0 As Single: t0 = Timer
    
    'join the list of PO numbers with "|"
    For Each cel In Range("POtomatch")
       sPo = Trim(cel.Value2)
       If Len(sPo) > 0 Then ' avoid blanks
           sPattern = sPattern & sep & sPo
           sep = "|"
       End If
    Next
    'Debug.Print sPattern
    
     ' regular expression to pattern match po
    Dim Regex As Object
    Set Regex = CreateObject("vbscript.regexp")
    With Regex
        .Global = False
        .MultiLine = False
        .IgnoreCase = True
        .pattern = sPattern
    End With
   
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objfolder = objFSO.GetFolder(POFOLDER)
    
    ' scan  files in folder
    With ActiveSheet
        outputrow = .Cells(.Rows.Count, "F").End(xlUp).Row
        For Each objfile In objfolder.Files
             If Regex.test(objfile.Name) Then
                 outputrow = outputrow + 1
                .Cells(outputrow, "F") = objfile.Name
                .Cells(outputrow, "G") = objfile.Path
                i = i + 1
             End If
             n = n + 1
        Next
    End With
    
    MsgBox n & " files scanned, " & vbLf & _
           i & " matched", vbInformation, Format(Timer - t0, "0.0 secs")
    
End Sub

相关问题