VBA网页数据提取问题：无法获取MercadoFut系列表格数据

问题背景 #

需要抓取指定页面中class为tabConteudo的表格内，id为MercadoFut0、MercadoFut1、MercadoFut2的<td>元素包含的数据，但现有VBA代码无法获取目标数据。

问题原因分析 #

1. URL参数不匹配：原代码中请求的Mercadoria参数为DI1，但需求目标是DAP，导致请求页面与目标不符
2. 元素定位逻辑错误：原代码尝试通过getElementById获取table元素，但实际目标是<td>元素，且这些<td>内部嵌套了需要提取的表格
3. 请求头缺失：目标网站可能验证请求来源，原代码未设置必要的请求头（如User-Agent），可能被服务器拦截或返回不完整内容

修正后的VBA代码 #

Sub ScrapeBMFData()
    Dim objHTTP As New WinHttp.WinHttpRequest
    Dim htmlDoc As New HTMLDocument
    Dim targetTD As Object
    Dim tableRow As Object
    Dim tableCell As Object
    
    Dim url As String
    Dim targetIDs As Variant
    Dim sheetRow As Integer
    Dim i As Integer

    ' 修正URL参数：Mercadoria改为DAP
    url = "https://www2.bmf.com.br/pages/portal/bmfbovespa/boletim1/SistemaPregao1.asp?pagetype=pop&caminho=Resumo%20Estat%EDstico%20-%20Sistema%20Preg%E3o&Data=15/04/2024&Mercadoria=DAP"

    ' 设置请求头，模拟浏览器访问
    objHTTP.Open "GET", url, False
    objHTTP.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/124.0.0.0 Safari/537.36"
    objHTTP.send

    ' 解析HTML响应
    htmlDoc.body.innerHTML = objHTTP.responseText

    ' 目标TD元素的ID列表
    targetIDs = Array("MercadoFut0", "MercadoFut1", "MercadoFut2")

    ' 从第1行开始写入数据
    sheetRow = 1

    ' 遍历每个目标TD元素
    For i = LBound(targetIDs) To UBound(targetIDs)
        Set targetTD = htmlDoc.getElementById(targetIDs(i))

        If Not targetTD Is Nothing Then
            Dim rowNum As Integer, colNum As Integer
            rowNum = sheetRow
            
            ' 提取TD内的表格行
            For Each tableRow In targetTD.getElementsByTagName("tr")
                colNum = 1
                ' 提取每行的单元格内容
                For Each tableCell In tableRow.getElementsByTagName("td")
                    Sheets("Planilha1").Cells(rowNum, colNum).Value = tableCell.innerText
                    colNum = colNum + 1
                Next tableCell
                rowNum = rowNum + 1
            Next tableRow
            
            ' 表格间留一行空白
            sheetRow = rowNum + 1
        Else
            MsgBox "未找到ID为'" & targetIDs(i) & "'的元素!", vbExclamation
        End If
    Next i

    MsgBox "数据提取完成!", vbInformation
End Sub

关键修改说明 #

• 修正了URL中的Mercadoria参数，确保请求目标页面
• 添加了User-Agent请求头，模拟浏览器访问，避免被服务器拦截
• 调整元素定位逻辑：先定位目标<td>元素，再提取其内部的表格行和单元格
• 变量命名更清晰，便于维护

内容的提问来源于stack exchange，提问作者Osvaldo Assunção