使用VBA抓取网页中的span标签

Question

我在使用 VBA 从网站获取数据时遇到问题...此方法会产生错误，因为 html 对象不支持 getelementbyclassname。请问有没有其他方法可以获取我想要的数据？

Option Explicit

Public Sub getlist()
[a:b].ClearContents 'clear all contents

   Dim strurl As String
   strurl = "https://www.bloomberg.com/quote/HSB22A2:LX"
   Dim html As Object: Set html = CreateObject("htmlfile")
   With CreateObject("msxml2.xmlhttp")
       .Open "get", strurl, False
       .send
       Do While .readyState <> 4
           DoEvents
       Loop
       'html.body.innerHtml = .responseText
   End With

   With html.getElementsByClassName("fieldLabel__9f45bef7")(0) '-->generate bugs
        'MsgBox (.innerText)

   End With

End Sub

Answer 1

我还努力用.getElementsByClassName 抓取网页，但几乎放弃了它，直到我最近发现如果将容器“HTML”对象标注为对象，它将无法工作。但是，如果您满足以下条件，它确实有效：

1. 添加对“Microsoft HTML 对象库”的引用（菜单“Tools” -> “References”）；和
2. 将容器对象声明为HTMLDocument，然后实例化它。

我已将您的代码改写如下：

Option Explicit

Public Sub getlist()

[a:b].ClearContents 'clear all contents

   Dim strurl As String
   strurl = "https://www.bloomberg.com/quote/HSB22A2:LX"
   Dim html As HTMLDocument: Set html = New HTMLDocument
   With CreateObject("msxml2.xmlhttp")
       .Open "get", strurl, False
       .send
       Do While .readyState <> 4
           DoEvents
       Loop
       html.body.innerHtml = .responseText
   End With

   With html.getElementsByClassName("fieldLabel__9f45bef7")(0) '-->generate bugs
       MsgBox .innerText
   End With

End Sub

我只想补充一点，我取消了两行注释 - 即，代码从 .responseText 传输到 HTML 容器对象的位置（我认为您错误地注释了该​​行？）。无论如何，我测试了它，它似乎工作。希望这可以为您解决问题。

Answer 2

不确定您为什么使用后期​​绑定HTMLFile。微软在anti-trust settlement 中付出了很多钱来让每个人都拥有MSHTML/IE。如果您自己无法添加 Microsoft HTML Object Library，大多数 IT 部门（IMO）将允许添加它。然后，您可以访问扩展的方法集。后期绑定接口带来的限制使其很少值得使用。但是，我将向您展示与您的问题相关的 HTMLFile 的一个有趣用法：即，作为执行本机 javascript 方法的一种方式。

可以通过在.responseText 上使用正则表达式来获取页面上的所有统计信息，以获取页面用于存储该数据的EncodedURIComponent。页面本身对此进行解码，然后处理使用 JSON 解析器公开的 JSON 字符串。我们可以模仿这些步骤。使用HTMLFile 访问正则表达式上的decodeURIComponent 方法返回EncodedURIComponent；然后使用 json 解析器解析出我们想要的信息。我使用jsonconverter.bas 从那里下载原始代码并添加到名为JsonConverter 的标准模块中。然后您需要转到 VBE > 工具 > 参考 > 添加对Microsoft Scripting Runtime 的引用。从复制的代码中删除最上面的Attribute 行（这是为了直接导入.bas）。

---

VBA：

Option Explicit

Public Sub GetData()
    Dim http As Object, s As String, ws As Worksheet, re As Object

    Set http = CreateObject("MSXML2.XMLHTTP")
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    Set re = CreateObject("VBScript.RegExp")

    With re
        .Global = True
        .MultiLine = True
    End With

    Dim json As Object, uriComponent As String, decodedComponent As String

    With http
        .Open "GET", "https://www.bloomberg.com/quote/HSB22A2:LX", False
        .setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT" 'mitigate for being served cached results
        .send
        s = .responseText
        uriComponent = GetString(re, s, "decodeURIComponent\(""(.*?\));")
        decodedComponent = GetDecodedString(uriComponent)
        Set json = JsonConverter.ParseJson(decodedComponent) 'https://jsoneditoronline.org/?id=9da2917ba22a4e65a9202f73f6165eb5
    End With

    Dim quoteInfo As Object, r As Long, key As Variant, results()

    Set quoteInfo = json("quote")
    quoteInfo("pressReleases") = vbNullString 'get rid of unwanted collection

    ReDim results(1 To quoteInfo.Count, 1 To 2)

    For Each key In quoteInfo
        r = r + 1
        If IsNull(quoteInfo(key)) Then quoteInfo(key) = vbNullString
        results(r, 1) = key: results(r, 2) = quoteInfo(key)
    Next

    With ws
        .Cells(1, 1).Resize(UBound(results, 1), UBound(results, 2)) = results
    End With
End Sub

Public Function GetString(ByVal re As Object, ByVal s As String, ByVal p As String) As String
    With re
        .Pattern = p
        GetString = .Execute(s)(0).SubMatches(0)
    End With
End Function

Public Function GetDecodedString(ByVal encodedString As String) As String 'Adapted from  @konahn https://stackoverflow.com/questions/4998715/does-vba-have-any-built-in-url-decoding
     With CreateObject("htmlfile")
         .parentWindow.execScript "function decode(s) {return decodeURIComponent(s)}" 'https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/decodeURIComponent
         GetDecodedString = .parentWindow.decode(encodedString)
    End With
End Function

---

输出示例：

---

Json 提取

您可以在这里探索：https://jsoneditoronline.org/?id=9da2917ba22a4e65a9202f73f6165eb5

---

正则表达式解释： _{explore here}