Using XMLHTTP in Excel VBA to download website's table not working-CodePudding

I am trying to download a table of historical gold prices from the following website: www.lbma.org.uk/prices-and-data/precious-metal-prices#/table

Dim http As MSXML2.XMLHTTP60 
Set http = New MSXML2.XMLHTTP60

With http
     .Open "GET", "https://www.lbma.org.uk/prices-and-data/precious-metal-prices#/table", True 
     .setRequestHeader "User-Agent", "Mozilla/5.0"
     .setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
     .send

     Do  ' Wait till the page is loaded
        DoEvents
        Sleep (1)
    Loop Until .ReadyState = 4
End With

http.responseText is 115kB long and has all the text from the page etc., but none of the actual table with the gold price data. I am pretty new to xmlhttp - any idea what I am doing wrong?

CodePudding user response：

Here's an approach to pull the AM prices only, this should be easily extended to pull PM prices if you so desire.

What I did was review the XHR requests made on this site and noticed it uses JSON to send data to the page for prices for each section. This is likely why you aren't finding the table HTML on the page, it's being created.

In order for this code you'll need to load up the VBA-JSON project. This is used to parse the JSON, you can find that here. Follow the instructions on that page to get that added

Code

Option Explicit

Public Function GetHistoricalGoldPricesJSON() As String
    On Error GoTo ErrHand:
    Const url As String = "https://prices.lbma.org.uk/json/gold_am.json?r=166366104"
    
    With CreateObject("MSXML2.XMLHTTP")
         .Open "GET", url, False
         .send
         GetHistoricalGoldPricesJSON = .ResponseText
    End With
    
    Exit Function
    
ErrHand:
    GetHistoricalGoldPricesJSON = ""
End Function

Public Function GetGoldPricesJSON(JsonString As String) As Object
    On Error Resume Next
    If JsonString = "" Then
        Set GetGoldPricesJSON= Nothing
        Exit Function
    End If
    
    Set GetGoldPricesJSON= JsonConverter.ParseJson(JsonString)
End Function

Public Sub GetGoldPrices()
    Dim GoldPrices As Object: Set GoldPrices = GetGoldPricesJSON(GetHistoricalGoldPricesJSON())
    
    'Nothing found or there was an error
    If GoldPrices Is Nothing Then Exit Sub
    
    Dim GoldPrice  As Variant
    Dim GoldArray  As Variant
    Dim Price      As Variant: ReDim GoldArray(1 To 50000, 1 To 4)
    Dim i          As Long
    
    For Each GoldPrice In GoldPrices
        i = i   1
        GoldArray(i, 1) = GoldPrice("d")
        GoldArray(i, 2) = GoldPrice("v")(1)
        GoldArray(i, 3) = GoldPrice("v")(2)
        GoldArray(i, 4) = GoldPrice("v")(3)
    Next
    
    With ThisWorkbook.Sheets(1)
        .Cells.ClearContents
        .Range("A1:D1") = Array("Date", "USD AM Price", "GBP AM Price", "EUR AM Price")
        .Range(.Cells(2, 1), .Cells(i   1, 4)) = GoldArray
    End With
    
End Sub