Excel VBA web scraping

Option Explicit
Public Sub GetRates()
    Dim html As HTMLDocument, hTable As HTMLTable '<== Tools > References > Microsoft HTML Object Library
    
    Set html = New HTMLDocument
      
    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", "https://uk.investing.com/rates-bonds/financial-futures", False
        .setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT" 'to deal with potential caching
        .send
        html.body.innerHTML = .responseText
    End With
    
    Application.ScreenUpdating = False
    
    Set hTable = html.getElementById("cr1")
    WriteTable hTable, 1, ThisWorkbook.Worksheets("Sheet1")
    
    Application.ScreenUpdating = True
End Sub

Public Sub WriteTable(ByVal hTable As HTMLTable, Optional ByVal startRow As Long = 1, Optional ByVal ws As Worksheet)
    Dim tSection As Object, tRow As Object, tCell As Object, tr As Object, td As Object, r As Long, C As Long, tBody As Object
    r = startRow: If ws Is Nothing Then Set ws = ActiveSheet
    With ws
        Dim headers As Object, header As Object, columnCounter As Long
        Set headers = hTable.getElementsByTagName("th")
        For Each header In headers
            columnCounter = columnCounter + 1
            Select Case columnCounter
            Case 2
                .Cells(startRow, 1) = header.innerText
            Case 8
                .Cells(startRow, 2) = header.innerText
            End Select
        Next header
        startRow = startRow + 1
        Set tBody = hTable.getElementsByTagName("tbody")
        For Each tSection In tBody
            Set tRow = tSection.getElementsByTagName("tr")
            For Each tr In tRow
                r = r + 1
                Set tCell = tr.getElementsByTagName("td")
                C = 1
                For Each td In tCell
                    Select Case C
                    Case 2
                        .Cells(r, 1).Value = td.innerText
                    Case 8
                        .Cells(r, 2).Value = td.innerText
                    End Select
                    C = C + 1
                Next td
            Next tr
        Next tSection
    End With
End Sub

Source: stackoverflow.com

Similar codes

0 vote302 views1 answer
Vbnet round to nearnest thousand
VBA
0 vote277 views1 answer
Vba add shape oval
VBA
0 vote289 views1 answer
Columns dont autoresize on program start vb.net
VBA
1 vote270 views1 answer
Excel vba compare 2 rows
VBA
1 vote290 views1 answer
Vba format string as cash
VBA
1 vote284 views1 answer
Vb.net get name by Selection Changed
VBA
0 vote264 views1 answer
How to make a a msgbpx in vbs
VBA
0 vote272 views1 answer
Xlbycolumns is not declared
VBA
0 vote269 views1 answer
Sendkeys vba selenium
VBA
1 vote269 views1 answer
Excel vba unload userform
VBA