CODEWITHSUNDEEP
regexexcelvbaweb-scraping
MITHU
MITHU

Reputation: 164

Unable to scoop out specific portions from a webpage using regex

The following script written in vba can parse the names out of some json content from a webpage using xhr. I know there is a vba json converter out there as well to parse information from json content. If I could know the method to apply regex in such cases, I could have created the pattern to do the trick.

Current attempt (working one):

Sub GetNames()
    Dim str As Variant, N&, R&, rxp As New RegExp

    With New XMLHTTP60
        .Open "GET", "https://oresapp.asicanada.net/ores.imis.services/api/member/?address=&callback=angular.callbacks._0&city=&companyName=&personName=", False
        .send
        str = Split(.responseText, ":[{""Id"":")
    End With

    N = UBound(str)

    For R = 1 To N
        Cells(R, 1) = Split(Split(str(R), "FullName"":""")(1), """")(0)
    Next R
End Sub

Ain't it possible to parse names from the above link using regex?

Upvotes: 0

Views: 60

Answers (1)

QHarr
QHarr

Reputation: 84465

Yes. You can use a lazy regex as follows

Option Explicit

Public Sub GetFullNames()
    Dim results(), matches As Object, s As String
    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", "https://oresapp.asicanada.net/ores.imis.services/api/member/?address=&callback=angular.callbacks._0&city=&companyName=&personName=", False
        .send
        s = .responsetext
    End With
    With CreateObject("VBScript.RegExp")
        .Global = True
        .IgnoreCase = False
        .Pattern = "FullName"":""(.*?)"""
        .MultiLine = True
        Set matches = .Execute(s)
        ReDim results(1 To matches.Count)
   End With
   Dim match As Variant, r As Long
   For Each match In matches
       r = r + 1
       results(r) = match.submatches(0)
   Next
   With ThisWorkbook.Worksheets("Sheet1")
       .Cells(1, 1).Resize(UBound(results), 1) = Application.Transpose(results)
   End With
End Sub

enter image description here

Lazy quantifier:

The lazy .*? guarantees that the quantified dot only matches as many characters as needed for the rest of the pattern to succeed. Therefore, the pattern only matches one {START}…{END} item at a time, which is what we want.

No array:

Option Explicit
Public Sub GetFullNames()
    Dim matches As Object, s As String
    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", "https://oresapp.asicanada.net/ores.imis.services/api/member/?address=&callback=angular.callbacks._0&city=&companyName=&personName=", False
        .send
        s = .responsetext
    End With
    With CreateObject("VBScript.RegExp")
        .Global = True
        .IgnoreCase = False
        .Pattern = "FullName"":""(.*?)"""
        .MultiLine = True
        Set matches = .Execute(s)
    End With
    Dim match As Variant, r As Long
    For Each match In matches
        r = r + 1
        With ThisWorkbook.Worksheets("Sheet1")
            .Cells(r, 1) = match.submatches(0)
        End With
    Next
End Sub

Upvotes: 2

Related Questions