error when calling function to extract all regex matches "run-time error '1004': Application-defined or object defined error"

Question

I'm trying to extract all regex matches from a list of urls starting in A2 to "LastRow" and put the all matches separated by a comma in column C.

I'm referencing the function "regexexicute", and every time I run the code, I get:

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

When I click debug, it highlights this line in yellow:

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

Below is the VBA code I'm trying to run, and below that the function it calls out:

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

Update Solved- I was able to replace RegexExecute to the RegexExtract method mentioned in this [Answer] as suggested in the comments Matt.G 51. Thanks.

Please, use special tags for you code. How do you think *yourself* - is your code readable? — JohnyL, May 20 '18 at 20:18
You cannot insert a `Matches` object into a cell - how would that work? You'll need to extract the match values and format them into a string. — Tim Williams, May 20 '18 at 21:31
see if you could change your RegexExecute to the RegexExtract method mentioned in this [answer](https://stackoverflow.com/questions/8146485/returning-a-regex-match-in-vba-excel/8146688) — Matt.G, May 21 '18 at 00:25

score 0 · Accepted Answer · edited Nov 01 '18 at 20:35

0

Update. Solved - I was able to replace RegexExecute to the RegexExtract method mentioned in this [Answer] as suggested in the comments Matt.G 51. Thanks.

edited Nov 01 '18 at 20:35

qiAlex

4,290
2
19
35

answered Nov 01 '18 at 19:35

Martin Boudreaux

3
2

error when calling function to extract all regex matches "run-time error '1004': Application-defined or object defined error"

1 Answers1