如何通过 VBA 提取雅虎财经分析师价格目标？

Question

我正在尝试通过 VBA（例如：分析师人数、高、低、平均、当前）

提取雅虎财经分析师的价格目标

但我无法通过 .getelementsbyclassname/.getelementbyID 提取其中任何一个。

这是我的代码：

Sub Analysis_import()

Dim website As String

Dim request As Object

Dim response As String

Dim html As New HTMLDocument

Dim price As Variant

website = "https://finance.yahoo.com/quote/AAPL/analysis?p=AAPL"

Set request = CreateObject("MSXML2.XMLHTTP")

request.Open "get", website, False

request.setRequestHeader "If-Modified-since", "Sat, 1 Jan 2000 00:00:00 GMT"

request.send

response = StrConv(request.responseBody, vbUnicode)

html.body.innerHTML = response

price = html.getElementsByClassName("Fz(m) D(ib) Td(inh)").innerText

Debug.Print price

End Sub

问题是什么？非常感谢！

Answer 1

您希望从该站点获取的字段是动态生成的，因此您无法使用 HTMLDocument 解析器获取它们。如果您想使用 tag、id、class e.t.c 来定位字段，您的选项是 IE 或 Selenium.

不过，好消息是原始 json 内容中的某些脚本标记中提供了必填字段。因此，即使您坚持使用 xmlhttp 请求，您也可以使用 vba json converter 或正则表达式处理它们。以下脚本基于正则表达式。

Sub GrabAnalysisInfo()
    Const Url As String = "https://finance.yahoo.com/quote/AAPL/analysis?p=AAPL"
    Dim sResp$, sHigh$, currentPrice$
    Dim analystNum$, sLow$, tMeanprice$

    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", Url, False
        .setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/88.0.4324.150 Safari/537.36"
        .send
        sResp = .responseText
    End With

    With CreateObject("VBScript.RegExp")
        .Pattern = "numberOfAnalystOpinions[\s\S]+?raw"":(.*?),"
        If .Execute(sResp).count > 0 Then
            analystNum = .Execute(sResp)(0).SubMatches(0)
        End If

        .Pattern = "targetMeanPrice[\s\S]+?raw"":(.*?),"
        If .Execute(sResp).count > 0 Then
            tMeanprice = .Execute(sResp)(0).SubMatches(0)
        End If

        .Pattern = "targetHighPrice[\s\S]+?raw"":(.*?),"
        If .Execute(sResp).count > 0 Then
            sHigh = .Execute(sResp)(0).SubMatches(0)
        End If

        .Pattern = "targetLowPrice[\s\S]+?raw"":(.*?),"
        If .Execute(sResp).count > 0 Then
            sLow = .Execute(sResp)(0).SubMatches(0)
        End If

        .Pattern = "currentPrice[\s\S]+?raw"":(.*?),"
        If .Execute(sResp).count > 0 Then
            currentPrice = .Execute(sResp)(0).SubMatches(0)
        End If
    End With

    Debug.Print analystNum, tMeanprice, sHigh, sLow, currentPrice
End Sub

如何通过 VBA 提取雅虎财经分析师价格目标？

How to extract yahoo-finance analyst price targets by VBA?

vba

web-scraping

yahoo-finance