如何利用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内容中的某些脚本标记中提供了所需的字段。因此，即使您坚持使用vba json变换器请求，也可以使用xmlhttp或regex处理它们。下面的脚本基于regex。

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