使用 VBA 抓取时出现的问题 - VBA Web Scraping

Posted 2023-03-27

【中文标题】使用 VBA 抓取时出现的问题 - VBA Web Scraping

【英文标题】：Problems While Scraping with VBA - VBA Web Scraping

【发布时间】：2022-01-08 14:49:19

【问题描述】：

我试图从网站的静态页面中获取一个数字，但是当我执行 html 请求时，结果是一个奇怪的 HTML，没有我想要的原始 html 的信息。

我试图获取信息的网站是： https://fnet.bmfbovespa.com.br/fnet/publico/exibirDocumento?id=233361&cvm=true 但我可以得到相同的结果： https://fnet.bmfbovespa.com.br/fnet/publico/visualizarDocumento?id=233361&cvm=true

我要获取的数字是页面中的数字“0,05”

我的代码是：

Sub trying()
Dim html As HTMLDocument
Set html = New HTMLDocument
With CreateObject("MSXML2.XMLHTTP")
    .Open "GET", "https://fnet.bmfbovespa.com.br/fnet/publico/exibirDocumento?id=233361&cvm=true&", False
    .setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT" 'to deal with potential caching
    .send
    html.body.innerHTML = .responseText
End With
Set element = html.getElementsByTagName("td")(31).innerText
Sheets("Sheet1").Cells(1, 1) = element    
End Sub

我也尝试过使用 InternetExplorer.Application 进行此操作，但问题仍然存在

【问题讨论】：

请阅读“How to Ask”、“Stack Overflow question checklist”、“minimal reproducible example”及其链接页面。当询问关于抓取的问题时，我们需要最少的 HTML 和代码来运行和复制问题在问题本身中。

【参考方案1】：

尝试了一堆请求头后，需要Accept请求头以HTML返回响应：

Sub trying()
    Dim html As HTMLDocument
    Set html = New HTMLDocument
        
    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", "http://fnet.bmfbovespa.com.br/fnet/publico/exibirDocumento?id=233361&cvm=true&", False
        .setRequestHeader "Accept", "text/html,application/xhtml+xml,application/xml;q=0.9,image/avif,image/webp,image/apng,*/*;q=0.8,application/signed-exchange;v=b3;q=0.9"
        .send
        html.body.innerHTML = .responseText
    End With
    
    Dim element As String
    element = html.getElementsByTagName("td")(32).innerText
    Sheets("Sheet1").Cells(1, 1) = element
End Sub

【讨论】：

这个标题解决了我的问题，谢谢！

【参考方案2】：

只需在请求中添加.htm（或.html）扩展名即可指定所需的文件类型。

Option Explicit

Public Sub trying()
    Dim html As MSHTML.HTMLDocument
    Set html = New MSHTML.HTMLDocument
    
    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", "https://fnet.bmfbovespa.com.br/fnet/publico/exibirDocumento.htm?id=233361", False
        .send
        html.body.innerHTML = .responseText
    End With
    Debug.Print html.querySelector("tr:nth-child(6) .dado-valores").innerText
End Sub

---

需要更多努力的替代方案包括在写入.innerHTML 之前添加接受标头或base64 解码.responseText。

如果您使用 here 中的函数（注意：很确定这不是原始来源），使用不太优选的 base64 解码路线，那么您将需要修改以下行：

 .DataType = "bin.base64": .Text = Replace$(b64, Chr$(34), vbNullString) 'modified line

---

Public Function DecodeBase64(b64$)
    Dim b
    With CreateObject("Microsoft.XMLDOM").createElement("b64")
        .DataType = "bin.base64": .Text = Replace$(b64, Chr$(34), vbNullString) 'modified line
        b = .nodeTypedValue
        With CreateObject("ADODB.Stream")
            .Open: .Type = 1: .Write b: .Position = 0: .Type = 2: .Charset = "utf-8"
            DecodeBase64 = .ReadText
            .Close
        End With
    End With
End Function