在表 II 中抓取特定数据

Question

我讨厌我不得不再次问这个问题，但是我一直在从更新中抓取数据的网站，不仅仅是在美学上，底层代码也发生了变化。在更新之前，程序会查找“关键数据”表并使用计数器查找特定数据。问题是我不再进入值，当我尝试使用更接近值的类名时，它根本找不到它并退出程序。

我已经剪掉了下面的一些代码来分享，不胜感激。和上次一样，我感觉很接近，但我还不够。

Set ieObj = New InternetExplorer
ieObj.Visible = True
ieObj.navigate "https://web.tmxmoney.com/quote.php?qm_symbol=" & Cells(c, 2) & ":US"

Do While ieObj.readyState <> 4
    Application.StatusBar = "Getting to 'Key Data' Table"
    DoEvents
Loop

d = 0
For Each htmlELE In ieObj.document.getElementsByClassName("sc-kfYqjs jpcbJh")
    
    'scrape EPS amount
    If d = 9 Then
        EPS = htmlELE.innerText
        Range("H2").value = EPS
    End If

    'scrape dividend
    If d = 14 Then
        div = htmlELE.innerText
        Range("I2").value = div
    End If

d = d + 1
Next

Answer 1

这是一个动态页面。内容将通过向下滚动加载。所以你必须等待加载页面的“第一部分”。然后向下滚动到所需的表格 1500。向下滚动后等待加载表格。

您不需要循环来抓取想要的值。您可以使用querySelector() 通过属性名称和属性值获取特定元素。

在此处查看有关querySelector()的信息
这里的例子你也可以使用querySelector():querySelectorAll()

此代码对我有用。如果不是你玩的休息时间和滚动量：

Sub test()

Dim ieObj As Object
Dim nodeEps As Object
Dim nodeDividend As Object
Dim eps As String
Dim dividend As String

  Set ieObj = CreateObject("InternetExplorer.Application")
  ieObj.Visible = True
  'ieObj.navigate "https://web.tmxmoney.com/quote.php?qm_symbol=" & Cells(c, 2) & ":US"
  ieObj.navigate "https://web.tmxmoney.com/quote.php?qm_symbol=GE:US"
  
  Do While ieObj.readyState <> 4
    Application.StatusBar = "Getting to 'Key Data' Table"
    DoEvents
  Loop
  Application.Wait (Now + TimeSerial(0, 0, 3))
  ieObj.document.parentWindow.Scroll 0, 1500
  Application.Wait (Now + TimeSerial(0, 0, 2))
  
  'scrape EPS amount
  Set nodeEps = ieObj.document.querySelector("div[data-testid='eps-value']")
  eps = Trim(nodeEps.innerText)
  'Range("H2").Value = eps
  
  'scrape dividend
  Set nodeDividend = ieObj.document.querySelector("div[data-testid='dividendAmount-value']")
  dividend = Trim(nodeDividend.innerText)
  'Range("I2").Value = dividend
  
  'Clean up
  ieObj.Quit
  Set ieObj = Nothing
  Set nodeEps = Nothing
  Set nodeDividend = Nothing
  Application.StatusBar = False
  
  MsgBox eps & Chr(13) & dividend
End Sub

Answer 2

如果您将发布请求连同适当的参数一起发送到正确的 url，您可以使用 xmlhttp 请求获取 eps 的值。运行脚本时，您应该得到包含所需结果的 json 响应。我使用正则表达式来解析您感兴趣的特定部分。

有效载荷比平时大。但是，您可以相应地更改变量中的代码名称。

你可以这样做：

Sub GetContent()
    Const link = "https://app-money.tmx.com/graphql"
    Dim elem As Object, payload As Variant, S$, tickerName$
    
    tickerName = "AAPL:US"      'use ticker name here

    payload = "{""operationName"":""getQuoteBySymbol"",""variables"":{""symbol"":""" & tickerName & """,""locale"":""en""},""query"":""query getQuoteBySymbol($symbol: String, $locale: String) {\n  getQuoteBySymbol(symbol: $symbol, locale: $locale) {\n    symbol\n    name\n    price\n    priceChange\n    percentChange\n    exchangeName\n    exShortName\n    exchangeCode\n    marketPlace\n    sector\n    industry\n    volume\n    openPrice\n    dayHigh\n    dayLow\n    MarketCap\n" & _
            "MarketCapAllClasses\n    peRatio\n    prevClose\n    dividendFrequency\n    dividendYield\n    dividendAmount\n    dividendCurrency\n    beta\n    eps\n    exDividendDate\n    shortDescription\n    longDescription\n    website\n    email\n    phoneNumber\n    fullAddress\n    employees\n    shareOutStanding\n    totalDebtToEquity\n    totalSharesOutStanding\n    sharesESCROW\n    vwap\n    dividendPayDate\n    weeks52high\n    weeks52low\n    alpha\n    averageVolume10D\n    averageVolume30D\n    averageVolume50D\n    priceToBook\n    priceToCashFlow\n    returnOnEquity\n" & _
            "returnOnAssets\n    day21MovingAvg\n    day50MovingAvg\n    day200MovingAvg\n    dividend3Years\n    dividend5Years\n    datatype\n    __typename\n  }\n}\n""}"

    With CreateObject("MSXML2.XMLHTTP")
        .Open "POST", link, False
        .setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/85.0.4183.102 Safari/537.36"
        .setRequestHeader "Content-Type", "application/json"
        .send payload
        S = .responseText
    End With
    
    With CreateObject("VBScript.RegExp")
        .Global = True
        .MultiLine = True

        .Pattern = """eps"":(.*?),"
        Set elem = .Execute(S)
        MsgBox elem(0).SubMatches(0)
    End With
End Sub