Web Scraping in excel VBA

Question

I'm trying to scrape a table from the web but for some reason I'm not getting the entire table. It's only fetching 1 column instead of them all. Any help would be greatly appreciated! Thanks!

Here's my code:

Sub HistoricalData()

    Dim xmlHttp As Object
    Dim TR_col As Object, TR As Object
    Dim TD_col As Object, TD As Object
    Dim row As Long, col As Long

    Set xmlHttp = CreateObject("MSXML2.XMLHTTP.6.0")
    xmlHttp.Open "GET", "http://www.cnbc.com/bonds-canada-treasurys", False
    xmlHttp.setRequestHeader "Content-Type", "text/xml"
    xmlHttp.send

    Dim html As Object
    Set html = CreateObject("htmlfile")
    html.body.innerHTML = xmlHttp.responseText

    Dim tbl As Object
    Set tbl = html.getElementById("curr_table")

    row = 1
    col = 1

    Set TR_col = html.getElementsByTagName("TR")
    For Each TR In TR_col
        Set TD_col = TR.getElementsByTagName("TD")
        For Each TD In TD_col
            Cells(row, col) = TD.innerText
            col = col + 1
        Next
        col = 1
        row = row + 1
    Next
End Sub

Answer 1

The problem is that you are getting the HTTP.responseText back before the page is finished loading.

I was unable to getMSXML2.XMLHTTP.6.0 to wait for the page to finish loading before returning the HTTP.responseText, so I switched to IE.

Sub HistoricalData()
    Const URL As String = "http://www.cnbc.com/bonds-canada-treasurys"
    Const READYSTATE_COMPLETE As Integer = 4
    Dim IE As Object
    Dim TR_col As Object, TR As Object
    Dim TD_col As Object, TD As Object
    Dim row As Long, col As Long

    Set IE = CreateObject("InternetExplorer.Application")

    IE.Navigate URL

    Do While (IE.Busy Or IE.ReadyState <> READYSTATE_COMPLETE)
        DoEvents
    Loop

    Set TR_col = IE.Document.getElementsByTagName("TR")

    For Each TR In TR_col
        Set TD_col = TR.getElementsByTagName("TD")

        For Each TD In TD_col
            Cells(row, col) = TD.innerText
            col = col + 1
        Next
        col = 1
        row = row + 1
    Next
End Sub

Answer 2

A few years late, I know, but here's a much more elegant solution IMHO, which gives you more control over the data, in the hope that someone will find it useful sometime.

The problem is you are requesting the whole page, instead of just the data.

For this solution you will need to import VBA-JSON and add a reference to Microsoft Scripting Runtime

Sub cnbc()
Dim req As New WinHttpRequest
Dim reqURL As String
Dim respString As String
Dim respJSON As Object
Dim item As Object
Dim i As Long
Dim key As String
i = 1
reqURL = "https://quote.cnbc.com/quote-html-webservice/quote.htm?partnerId=2&requestMethod=quick&exthrs=1&noform=1&fund=1&output=jsonp&symbols=CA1M-CA|CA3M-CA|CA1Y-CA|CA3Y-CA|CA4Y-CA|CA5Y-CA|CA20Y-CA|CA30Y-CA&callback=quoteHandler1"
With req
    .Open "GET", reqURL, False
    .send
    respString = .responseText
End With
key = "quoteHandler1("
respString = Mid(respString, InStr(respString, key) + Len(key), Len(respString) - Len(key) - 1) 'extract the JSON string
Set respJSON = JsonConverter.ParseJson(respString) 'parse JSON string into something usable
For Each item In respJSON("QuickQuoteResult")("QuickQuote")
    ThisWorkbook.Worksheets(1).Cells(i, "A") = item("shortName")
    ThisWorkbook.Worksheets(1).Cells(i, "B") = item("last")
    ThisWorkbook.Worksheets(1).Cells(i, "C") = item("change")
    i = i + 1
Next item
End Sub