CODEWITHSUNDEEP
htmlexcelvbaweb-scrapingfinance
Christopher Weckesser
Christopher Weckesser

Reputation: 373

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

Upvotes: 0

Views: 468

Answers (1)

ASH
ASH

Reputation: 20332

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

Upvotes: 1

Related Questions