regex - 调用函数以提取所有正则表达式匹配时出错“运行时错误'1004'：应用程序定义或对象定义错误”

问题描述

我正在尝试从从 A2 到“LastRow”的 url 列表中提取所有正则表达式匹配项，并将所有匹配项用逗号分隔在 C 列中。

我正在引用函数“regexecute”，每次运行代码时，我都会得到：

"run-time error '1004': Application-defined or object defined error"

当我单击调试时，它以黄色突出显示这一行：

"ActiveCell.Offset(0, 2).Value = RegexExecute(str, "url.*?(\/products\/.*?).>", False)"

下面是我试图运行的 VBA 代码，下面是它调用的函数：

Sub Scrape_all_matches_by regex()

'Start Callouts
    Dim navtar As String
    Dim oHTTP As Object
    Dim str As String
    Dim reg As String
    'Dim body As String
    Dim sht As Worksheet
    Dim LastRow As Long
    Dim cell As Range
    Dim DataRange As Range
    Set sht = ActiveSheet
    Set oHTTP = CreateObject("msxml2.ServerXMLHTTP")
    LastRow = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row
'End callouts

'Start- Find Last Row & Do stuff to all cells between first &  last row
    Set DataRange = Range("A2:A" & LastRow)
    For Each cell In DataRange
        cell.Activate
        navtar = Replace(Replace(Replace(ActiveCell.Value, "https://", ""), "http://", ""), "www.", "") 'Clean URL
        navtar = "http://" & navtar
        'On Error GoTo HTTPErr:
        oHTTP.Open "GET", navtar, False
        oHTTP.send
        str = (oHTTP.responseText)

'Start- Do stuff to all cells between first &  last row
         ActiveCell.Offset(0, 2).Value = RegexExecute(str, "url.*?(\/products\/.*?).>", False)
'End- Do stuff to all cells between first &  last row

LoopPickup:
        Next
'End- Find Last Row & Do stuff to all cells between first &  last row
        MsgBox "Done"
        Exit Sub
'Start- URL error handeling
HTTPErr:
        If Err.Number <> 0 Then
        ActiveCell.Offset(0, 1).Value = "Error: " & Err.Description
        End If
        Resume LoopPickup
'end- URL error handeling

End Sub

Function RegexExecute(str As String, reg As String, Optional findOnlyFirstMatch As Boolean = False) As Object
'Executes a Regular Expression on a provided string and returns all matches
'str - string to execute the regex on
'reg - the regular expression
    Dim Regex As Object
    Set Regex = CreateObject("VBScript.RegExp"): Regex.Pattern = reg
    Regex.Global = Not (findOnlyFirstMatch)
    If Regex.Test(str) Then
        Set RegexExecute = Regex.Execute(str)
        Exit Function
    End If
End Function

更新已解决-我能够将 RegexExecute 替换为此[Answer]中提到的 RegexExtract 方法，如评论 Matt.G 51 中所建议的那样。谢谢。

标签： regexexcelweb-scrapingvba

regex - 调用函数以提取所有正则表达式匹配时出错“运行时错误'1004'：应用程序定义或对象定义错误”

问题描述

解决方案

推荐阅读