Search code examples
excelvbascreen-scraping

How to get data from table using "msxml2.xmlhttp"


HTMLI am trying to get data from a webpage https://www.lbma.org.uk/prices-and-data/precious-metal-prices#/table Seemed simple with all the q and a examples online but I'm flapping around like a kipper and reduced to guessing after much trial and error. Could someone please show where I am going wrong?

The aim,,, my wbook data has always been manually updated regularly so the aim now is to download say the first 10 rows of gold prices only and preferably without the Euro data just date, USD and GBP. Headers are not required either just data.

Here is the HTML and code so far. Errors encountered have been 'Object required' and 'Object doesn't support,,,' etc.

Sub Get_Prices()

    Dim sWeb_URL As String
    Dim oHTML_Content As Object, oTbl As Object, tr As Object, td As Object, oTBody As Object
    Dim r As Long, c As Long, arr

    With Sheets(20)
        sWeb_URL = "https://www.lbma.org.uk/prices-and-data/precious-metal-prices#/table"
        Set oHTML_Content = CreateObject("htmlfile")

        ''get entire webpage content into HTMLFile Object
        With CreateObject("msxml2.xmlhttp")
            .Open "GET", sWeb_URL, False
            .send
            oHTML_Content.body.innerHTML = .responseText
        End With

        'Set oTbl = oHTML_Content.getElementsByTagName("-index1")
        'Set oTbl = oHTML_Content.getElementById("-index1")
        'Set oTbl = oHTML_Content.getElementsByClassName("pepper-responsive-table")
        'Set oTbl = oHTML_Content.getElementsByClassName("pepper-responsive-table").getElementsByTagName("tbody")(0).getElementsByTagName("tr")(0)
        'Set oTbl = oHTML_Content.getElementsByClassName("pepper-responsive-table")(0).getElementsByTagName("tr")(2)
        Set oTbl = oHTML_Content.getElementsByTagName("tbody")

        For Each tr In oTbl
            c = 1
            For Each td In tr.Cells
                .Cells(r, c) = td.innerText
                c = c + 1
            Next td
            r = r + 1
        Next tr
            
    End With

End Sub

Solution

  • After reading @Zwenn's comment I wrote the following code and brought the values to the sheet.

    'THIS PUBLIC FUNCTION IN A MODULE
    --------------------------------------------------------
    Public Function fetch_prices(ByRef AM, ByRef PM, ByVal afterMonth As String) As String
       Dim c As Integer, a As Long, lb As Integer
       Dim URL() As Variant    ', fileSaveTo() As Variant
       
       'change the files path to any valid local path
       'fileSaveTo = Array(".\AM_PRICES.TXT", ".\PM_PRISES.TXT")
       URL = Array("https://prices.lbma.org.uk/json/gold_am.json?r=84419867", _
                          "https://prices.lbma.org.uk/json/gold_pm.json?r=796011502")
       lb = LBound(URL)
                          
        With CreateObject("msxml2.xmlhttp")
           For c = lb To UBound(URL)
             .Open "GET", URL(c), False
             .send
                'Call WriteToTextFile(fileSaveTo(c), .responseText)
             a = InStrRev(.responseText, afterMonth)
             If a > 0 Then
                If (c = lb) Then
                   AM = Mid(.responseText, a)
                Else
                   PM = Mid(.responseText, a)
                End If
             End If
          Next
       End With
    End Function
    
    
    'THE PRIVATE SUBs IN THE SHEET MODULE
    ----------------------------------------------------
    Private Sub get_prices(afterTheMont As String)
       Const d = """d"""
       Dim AM As String, PM As String, pa As Long, lb As Long, rb As Long, rowId As Long, cc As Long
       Dim dt As String, values As Variant
       Call fetch_prices(AM, PM, afterTheMont)
       pa = 1: rowId = 3
       
      
    
        Do
          rowId = rowId + 1
          pa = InStr(pa + 1, AM, d)
          If (pa <= 0) Then Exit Do
          dt = Mid(AM, pa + 5, 10)
          Me.Cells(rowId, 1).Value2 = dt
          lb = InStr(pa, AM, "[")
          If lb > 0 Then
             rb = InStr(pa, AM, "]")
             If rb > 0 Then
                values = Split(Mid(AM, lb + 1, rb - lb - 1), ",")
                For cc = LBound(values) To UBound(values)
                   Me.Cells(rowId, cc + 2).Value2 = values(cc)
                Next
             End If
          End If
       Loop
       
       rowId = 3
       Do
          rowId = rowId + 1
          pa = InStr(pa + 1, PM, d)
          If (pa <= 0) Then Exit Do
          dt = Mid(PM, pa + 5, 10)
          Me.Cells(rowId, 5).Value2 = dt
          lb = InStr(pa, PM, "[")
          If lb > 0 Then
             rb = InStr(pa, PM, "]")
             If rb > 0 Then
                values = Split(Mid(PM, lb + 1, rb - lb - 1), ",")
                For cc = LBound(values) To UBound(values)
                   Me.Cells(rowId, cc + 6).Value2 = values(cc)
                Next
             End If
          End If
       Loop
    
       
    End Sub
    
    'usage via command button click event
    Private Sub CommandButton1_Click()
       'it means show in sheet the prices from the first day exist data of the next month
       Call get_prices("2023-04")
    End Sub
    

    enter image description here