VBA调用GetElementById等方法抓取网页数据结果不稳定如何解决

核心故障原因 #

• 缺少HTTP请求校验逻辑：代码未判断请求返回状态码，也未校验响应内容完整性，网络波动、请求被网站拒绝时会拿到残缺/错误的页面内容，直接解析就会出现数据错位、缺失的问题
• 未做反爬规避：连续30次无间隔的高频请求会触发目标网站的反爬机制，返回验证码、限流提示页而非正常数据页，导致解析结果时对时错
• 表格结构适配错误：目标网站的单条数据拆分在2个<tr>标签中，且表头包含跨行、空白行，直接逐行写入Excel会导致数据错位，偶尔匹配正确仅为巧合
• 请求协议不匹配：原代码使用HTTP协议请求，目标站已升级为HTTPS，跳转过程可能导致响应内容异常

修复后代码 #

Sub Gettab()
    Dim html As HTMLDocument
    Dim table As MSHTML.HTMLTable
    Dim sh As Worksheet
    Dim td As Object, tr As Object, r As Long, c As Long, i As Integer, retryCnt As Integer
    Dim dataRowFlag As Boolean, tempRow() As String
    
    ' 先判断工作表是否存在，避免重复创建报错
    Application.DisplayAlerts = False
    On Error Resume Next
    ThisWorkbook.Sheets("webtab").Delete
    On Error GoTo 0
    Application.DisplayAlerts = True
    Sheets.Add.Name = "webtab"
    Set sh = ThisWorkbook.Worksheets("webtab")
    
    r = 1
    dataRowFlag = False
    
    For i = 1 To 30
        retryCnt = 0
        ' 重试机制：最多重试3次
retry:
        URL = "https://www.cophieu68.vn/atbottom.php?currentPage=" & CStr(i) & "&&d=24&type=lo&lang=en"
        Set html = New HTMLDocument
        
        With CreateObject("MSXML2.XMLHTTP")
            .Open "GET", URL, False
            .SetRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/114.0.0.0 Safari/537.36"
            .send
            ' 状态码校验，仅200正常返回时解析
            If .Status = 200 Then
                html.body.innerHTML = .responseText
                ' 校验是否拿到正常数据表格
                If html.getElementById("fred") Is Nothing Then
                    If retryCnt < 3 Then
                        retryCnt = retryCnt + 1
                        Application.Wait Now + TimeValue("00:00:02") ' 失败后等2秒重试
                        GoTo retry
                    Else
                        MsgBox "第" & i & "页连续3次请求失败，已跳过"
                        GoTo nextPage
                    End If
                End If
            Else
                If retryCnt < 3 Then
                    retryCnt = retryCnt + 1
                    Application.Wait Now + TimeValue("00:00:02")
                    GoTo retry
                Else
                    MsgBox "第" & i & "页连续3次请求失败，已跳过"
                    GoTo nextPage
                End If
            End If
        End With
        
        Set table = html.getElementById("fred")
        ReDim tempRow(1 To table.Rows(0).Cells.Length * 2) ' 初始化临时数组，存储拆分的两行数据
        
        For Each tr In table.getElementsByTagName("tr")
            ' 过滤无内容的空白行
            If tr.Cells.Length > 0 And Trim(tr.Cells(0).innerText) <> "" Then
                ' 处理表头：单独写第一页的表头即可，后续页面跳过表头
                If i = 1 And r <= 3 Then
                    c = 1
                    For Each td In tr.getElementsByTagName("td")
                        sh.Cells(r, c) = td.innerText
                        c = c + 1
                    Next
                    r = r + 1
                Else
                    ' 合并拆分的两行数据为一行
                    If Not dataRowFlag Then
                        ' 第一行数据存入临时数组
                        c = 1
                        For Each td In tr.getElementsByTagName("td")
                            tempRow(c) = td.innerText
                            c = c + 1
                        Next
                        dataRowFlag = True
                    Else
                        ' 第二行数据追加到临时数组，写入Excel
                        For Each td In tr.getElementsByTagName("td")
                            tempRow(c) = td.innerText
                            c = c + 1
                        Next
                        ' 写入整行数据
                        For c = 1 To UBound(tempRow)
                            If tempRow(c) <> "" Then
                                sh.Cells(r, c) = tempRow(c)
                            End If
                        Next
                        Erase tempRow
                        dataRowFlag = False
                        r = r + 1
                    End If
                End If
            End If
        Next
        
nextPage:
        ' 每次请求完间隔1秒，避免触发反爬
        Application.Wait Now + TimeValue("00:00:01")
        Set table = Nothing
        Set html = Nothing
        Set tr = Nothing
        Set td = Nothing
    Next
End Sub

运行前请确认已在VBA编辑器的「工具-引用」中勾选「Microsoft HTML Object Library」，否则会报类型定义错误。

内容的提问来源于stack exchange，提问作者Cao Doremi