VBA - 网页抓取无法获取 HTMLElement innerText

Question

我正在尝试使用 excel VBA 取消汇率，但我无法获得所需的 innerText 值。我不明白为什么，因为相同的技术适用于其他网站。

网址 - https://www.nbs.rs/export/sites/default/internet/english/scripts/kl_srednji.html

Sub GetCurr()

Dim tempHTMLDoc As New MSHTML.HTMLDocument
Dim HTMLCurrency As MSHTML.IHTMLElementCollection
Dim HTMLRows As MSHTML.IHTMLElementCollection
Dim HTMLDate As MSHTML.IHTMLElementCollection
Dim HTMLElem As MSHTML.IHTMLElement
Dim connectionTest As Boolean
Dim EUR, CZK, HRK, HUF, PLN, RON, RSD As String
Dim myURL As String
Dim i As Long

connectionTest = True
myURL = "https://www.nbs.rs/export/sites/default/internet/english/scripts/kl_srednji.html"

Call WebConnection(tempHTMLDoc, connectionTest, myURL)
If connectionTest = False Then Exit Sub

Set HTMLDate = tempHTMLDoc.getElementsByTagName("span")
'Debug.Print HTMLDate.Length

For Each HTMLElem In HTMLDate 'I am looking for which element contains the date (can not find)
  Debug.Print HTMLElem.innerText
Next HTMLElem

'I am trying to get the necessary currencies
Set HTMLRows = tempHTMLDoc.getElementsByTagName("tr")

Debug.Print HTMLRows.Length

For i = 0 To HTMLRows.Length - 1 'If lenght > 0

    Set HTMLCurrency = HTMLRows(i).getElementsByTagName("td")

    If HTMLCurrency.Length > 4 Then 'each currency contains 5 "td" tags

        Select Case HTMLCurrency(2).innerText
            Case "EUR"
                EUR = HTMLCurrency(4).innerText
            Case "HRK"
                HRK = HTMLCurrency(4).innerText
            Case "HUF"
                HUF = HTMLCurrency(4).innerText
            Case "PLN"
                PLN = HTMLCurrency(4).innerText
            Case "RON"
                RON = HTMLCurrency(4).innerText
            Case "CZK"
                CZK = HTMLCurrency(4).innerText
        End Select

    End If

Next i

Debug.Print "EUR - ", EUR; vbNewLine; "HRK - ", HRK; vbNewLine; "HUF - ", HUF; vbNewLine; "PLN - ", PLN; vbNewLine; _
            "RON - ", RON; vbNewLine; "CZK - ", CZK

End Sub

'============================================================================

Sub WebConnection(HTMLDoc As MSHTML.HTMLDocument, ConnTest As Boolean, URL As String)

Dim XMLPage As New MSXML2.XMLHTTP60
Dim errorMsg As VbMsgBoxResult

On Error GoTo CONNECTION_ERROR

XMLPage.Open "GET", URL, False
XMLPage.send

On Error GoTo 0

If XMLPage.Status <> 200 Then
    errorMsg = MsgBox("There is something wrong with webpage. Do you want to try to continue?", vbYesNo + vbCritical, "ERROR")
    If errorMsg = vbNo Then
        ConnTest = False
        Exit Sub
    End If
End If

HTMLDoc.body.innerHTML = XMLPage.responseText
Exit Sub

CONNECTION_ERROR:
MsgBox "There is something wrong with the connection.", vbCritical, "ERROR"
ConnTest = False
Exit Sub

End Sub

我尝试使用 id (index:srednjiKursList:tbody_element) 或类名(tableCell) 但它不起作用。这个网站的构建方式不同

Answer 1

您的原始链接，我们称之为着陆页，是动态加载的。您的GET 请求太快，无法检索所需信息。

您可以使用另一个 URL。

当您转到登录页面时，您会看到它实际上向以下页面发出了XMLHTTP GET 请求：

以上内容来自使用 fiddler，但您可以使用例如 Chrome 开发工具 (F12) 来检查网络流量。

您可以将该 URL 直接输入到您的代码中，它可以完美运行。

---

整张桌子：

你也可以这样抓取整张桌子：

Option Explicit
Public Sub GetInfo()
    Dim html As New HTMLDocument, hTable As HTMLTable, clipboard As Object
    Const URL = "https://www.nbs.rs/kursnaListaModul/srednjiKurs.faces?lang=eng"

    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", URL, False
        .send
        html.body.innerHTML = StrConv(.responseBody, vbUnicode)
    End With

    Set hTable = html.getElementById("index:srednjiKursLista")
    Set clipboard = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
    clipboard.SetText hTable.outerHTML
    clipboard.PutInClipboard
    ThisWorkbook.Worksheets("Sheet1").Cells(1, 1).PasteSpecial
End Sub

---

结果示例：

---

---

仅列出的货币：

您还可以根据表格结构使用一些数学运算来获取您列出的那些元素。

Option Explicit
Public Sub GetInfo()
    Dim html As New HTMLDocument, hTable As HTMLTable, clipboard As Object
    Const URL = "https://www.nbs.rs/kursnaListaModul/srednjiKurs.faces?lang=eng"

    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", URL, False
        .send
        html.body.innerHTML = StrConv(.responseBody, vbUnicode)
    End With

    Set hTable = html.getElementById("index:srednjiKursLista")
 
    Dim list As Object, i As Long
    Dim EUR As Double, CZK As Double, HRK As Double, HUF As Double, PLN As Double, RON As Double, RSD As Double
    Set list = hTable.querySelectorAll("td")
    For i = 2 To list.Length - 1 Step 5
        Select Case list.item(i).innerText
        Case "EUR"
            EUR = list.item(i + 2).innerText
        Case "HRK"
            HRK = list.item(i + 2).innerText
        Case "HUF"
            HUF = list.item(i + 2).innerText
        Case "PLN"
            PLN = list.item(i + 2).innerText
        Case "RON"
            RON = list.item(i + 2).innerText
        Case "CZK"
            CZK = list.item(i + 2).innerText
        End Select
    Next
 
    Debug.Print "EUR - ", EUR; vbNewLine; "HRK - ", HRK; vbNewLine; "HUF - ", HUF; vbNewLine; "PLN - ", PLN; vbNewLine; _
                                                                                                      "RON - ", RON; vbNewLine; "CZK - ", CZK
End Sub

---

使用剪贴板：

下面一行：

GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")

添加对 Microsoft Forms 对象库的后期绑定引用，以便您可以访问剪贴板。

您也可以将用户表单添加到您的项目或转到 VBE > 工具 > 参考 > Microsoft Forms 对象库来访问：