如何在 VBA 中从雅虎财经（2019 URL）中提取财务报表

Question

I copied the code from this link Extract financial fundamental from Yahoo finance with excel

The code from ASH works to pull balance sheet data; however, when I change the ticker (like MSFT), it begins pulling in the wrong data.

1. Why is it pulling in different data points than when I switch the ticker in the URL Link?

2. How can I go about correcting it?

    Sub Yahoo_BS() 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") myURL = "https://finance.yahoo.com/quote/SBUX/balance-sheet?p=SBUX" xmlHttp.Open "GET", myURL, 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("Pos(r)") 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 code works just fine for MSFT in so far as it works the same way for that ticker as it does for SBUX. The code you linked to is for retrieving balance sheet info for a given ticker.

https://finance.yahoo.com/quote/SBUX/balance-sheet?p=SBUX

or

https://finance.yahoo.com/quote/MSFT/balance-sheet?p=MSFT

This does not guarantee you can 'lift and shift' this code for use with any of the other tabs eg income statement which has the following construction:

https://finance.yahoo.com/quote/MSFT/financials?p=MSFT

You will need to inspect the html of these tabs and see how it differs. There are already existing answers on StackOverflow covering how to obtain the data as shown in the other tabs (and by the different time periods eg Quarter).

---

VBA translation of existing answer . In VBA it would benefit from re-factoring:

Option Explicit

Public Sub WriteOutFinancialInfo()
    Dim http As Object, s As String

    Set http = CreateObject("MSXML2.XMLHTTP")

    With http
        .Open "GET", "https://finance.yahoo.com/quote/MSFT/financials?p=MSFT", False
        .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
        .send
        s = .responseText
    End With
    
    Dim html As MSHTML.HTMLDocument, html2 As MSHTML.HTMLDocument, re As Object, matches As Object
    
    Set html = New MSHTML.HTMLDocument: Set html2 = New MSHTML.HTMLDocument
    Set re = CreateObject("VBScript.RegExp")
    
    html.body.innerHTML = s
    
    Dim headers(), rows As Object
    
    headers = Array("Breakdown", "TTM")
    Set rows = html.querySelectorAll(".fi-row")
    
    With re
        .Global = True
        .MultiLine = True
        .Pattern = "\d{1,2}/\d{1,2}/\d{4}"
        Set matches = .Execute(s)
    End With
    
    Dim results(), match As Object, r As Long, c As Long, startHeaderCount As Long
    startHeaderCount = UBound(headers)
    ReDim Preserve headers(0 To matches.Count + startHeaderCount)

    c = 1
    For Each match In matches
        headers(startHeaderCount + c) = match
        c = c + 1
    Next
    
    Dim row As Object
    ReDim results(1 To rows.Length, 1 To UBound(headers) + 1)
 
    For r = 0 To rows.Length - 1
        html2.body.innerHTML = rows.Item(r).outerHTML
        Set row = html2.querySelectorAll("[title],[data-test=fin-col]")
        
        For c = 0 To row.Length - 1
            results(r + 1, c + 1) = row.Item(c).innerText
        Next c
    Next
    
    Dim ws As Worksheet
    
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    
    With ws
        .Cells(1, 1).Resize(1, UBound(headers) + 1) = headers
        .Cells(2, 1).Resize(UBound(results, 1), UBound(results, 2)) = results
    End With
End Sub

---

Project references:

VBE > Tools > References > Add reference to Microsoft HTML Object Library