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

not sure, been using this code I found online to scrape a bunch of tables, nows the online time its not working. — RageAgainstheMachine
– RageAgainstheMachine, Commented Dec 6, 2016 at 15:43
See the source of the page. you are loading exactly the table in the source of the web page. The data are loaded from a datasource — D. O.
– D. O., Commented Dec 6, 2016 at 16:47
@D.O. I'm a noob, can you explain this further? I clicked "inspect" but I dont see where the site is getting its data. — RageAgainstheMachine
– RageAgainstheMachine, Commented Dec 6, 2016 at 16:54

user6432984 · Accepted Answer · 2016-12-06 16:56:01Z

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

@ryguy7272 Thanks :-). Did you see: Tim Williams answer to Object Vba read items?

Stavros Jon · Accepted Answer · 2019-03-17 00:20:23Z

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

Collectives™ on Stack Overflow

Web Scraping in excel VBA

2 Answers 2

1 Comment

Comments

Linked

Hot Network Questions

Collectives™ on Stack Overflow

2 Answers 2

1 Comment

Comments

Linked

Related