Acquiring HTML element in VBA

Question

I'm trying to get the price of a coin from the Royal Mint web site.

The element I require doesn't have an ID or a class name.

Using the Chrome Developer Tools I think I've isolated what I need in the code below but I don't know how to progress further.

Public Function XMLscrapeTest2() As Integer

Dim XMLpage As New MSXML2.XMLHTTP60
Dim HTMLdoc As New MSHTML.HTMLDocument

Dim HTMLelement As MSHTML.IHTMLElement
Dim HTMLelements As Object
Dim HTMLspan As HTMLSpanElement

Dim strURL As String

    strURL = "https://www.royalmint.com/sovereign/all/1826-George-IV-Proof-Half-Sovereign/"

    XMLpage.Open "GET", strURL, False
    XMLpage.send
    HTMLdoc.body.innerHTML = XMLpage.responseText
            
    Set HTMLelements = HTMLdoc.getElementsByClassName("d-none d-md-block mb-0")
    Debug.Print "d-none d-md-block mb-0>>>" & HTMLelements.length
    Set HTMLelements = HTMLdoc.querySelectorAll("p")
    Debug.Print HTMLelements.length
    For intI = 0 To HTMLelements.length - 1
        Debug.Print intI, HTMLelements(intI).getAttribute("classname")
    Next intI            
End Function

IM Output

d-none d-md-block mb-0>>>1

8

0

1

2

3

4

5

6 d-none d-md-block mb-0

7

Answer 1

The portion of that webpage you are interested in is rendered via javascript, so you can't process it using an HTML parser. However, you can apply a regular expression to the reponsetext to grab the price. This is one of the ways you can achieve that:

Public Function XMLscrapeTest2() As Variant
    Dim XMLpage As Object, Rxp As Object
    Dim strURL As String, S As String
    Dim oMatches As Object
    
    Set XMLpage = CreateObject("MSXML2.XMLHTTP")
    Set Rxp = CreateObject("VBScript.RegExp")
    
    strURL = "https://www.royalmint.com/sovereign/all/1826-George-IV-Proof-Half-Sovereign/"
    
    XMLpage.Open "GET", strURL, False
    XMLpage.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/109.0.0.0 Safari/537.36"
    XMLpage.send
    S = XMLpage.responseText

    With Rxp
        .Global = True
        .MultiLine = True
        .IgnoreCase = True
        .Pattern = "price"":""(.*?)"""
        Set oMatches = .Execute(S)
        If oMatches.Count > 0 Then
            XMLscrapeTest2 = oMatches(0).SubMatches(0)
        Else
            XMLscrapeTest2 = "Not found"
        End If
    End With
End Function