Search code examples
htmlexcelvbaweb-scrapingfinance

Scraping tr class information using Excel VBA


I've created a simple program in Excel VBA to scrape all the information in a table from https://www.nasdaq.com/market-activity/stocks/aapl/financials. I've used similar code for other websites but for some reason I can't get this one working. Can anyone point what I'm missing? Any help would be much appreciated.

"EDITED CODE"

Public Sub GetCompanyFinancials()

Dim XMLPage As New MSXML2.XMLHTTP60
Dim HTMLDoc As New MSHTML.HTMLDocument
Dim HTMLTables As MSHTML.IHTMLElementCollection
Dim HTMLTable, HTMLRow, HTMLCell As MSHTML.IHTMLElement

XMLPage.Open "GET", "https://www.nasdaq.com/market-activity/stocks/aapl/financials", False
XMLPage.send

HTMLDoc.body.innerHTML = XMLPage.responseText

Set HTMLTables = HTMLDoc.getElementsByTagName("table")

For Each HTMLTable In HTMLTables
    For Each HTMLRow In HTMLTable.getElementsByTagName("tr")
        For Each HTMLCell In HTMLRow.Children
            Debug.Print HTMLCell.innerText
        Next HTMLCell
    Next HTMLRow
Next HTMLTable

End Sub

Solution

  • I'm sure there are MANY ways to do this kind of thing. Here is one.

    Sub Web_Table_Option_Two()
        Dim HTMLDoc As New HTMLDocument
        Dim objTable As Object
        Dim lRow As Long
        Dim lngTable As Long
        Dim lngRow As Long
        Dim lngCol As Long
        Dim ActRw As Long
        Dim objIE As InternetExplorer
        Set objIE = New InternetExplorer
        objIE.Navigate "https://www.nasdaq.com/market-activity/stocks/aapl/financials"
    
        Do Until objIE.ReadyState = 4 And Not objIE.Busy
            DoEvents
        Loop
        Application.Wait (Now + TimeValue("0:00:03")) 'wait for java script to load
        HTMLDoc.body.innerHTML = objIE.Document.body.innerHTML
        With HTMLDoc.body
            Set objTable = .getElementsByTagName("table")
            For lngTable = 0 To objTable.Length - 1
                For lngRow = 0 To objTable(lngTable).Rows.Length - 1
                    For lngCol = 0 To objTable(lngTable).Rows(lngRow).Cells.Length - 1
                        ThisWorkbook.Sheets("Sheet1").Cells(ActRw + lngRow + 1, lngCol + 1) = objTable(lngTable).Rows(lngRow).Cells(lngCol).innerText
                    Next lngCol
                Next lngRow
                ActRw = ActRw + objTable(lngTable).Rows.Length + 1
            Next lngTable
        End With
        objIE.Quit
    End Sub
    

    Result:

    enter image description here