如何通过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

等定位字段，您的选项将是

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

Answer 2

我尝试使用VBA脚本，但如果为假，则.Execute(sResp).count > 0，因此它无法从雅虎财经获取任何数据（tMeanprice、slow、shigh）。有可行的脚本吗？