Excel VBA网页爬虫抓取房产数据偶发91/424报错问题求解

问题背景 #

• 编写VBA程序用于解析房产列表页HTML，抓取地址、建造年份、房源特色等字段，其余字段仅需修改对应元素的class/ID即可复用抓取逻辑
• 目标站点为realtor.ca，无需登录即可访问，各房源页字段对应的HTML class、ID命名规则固定
• 测试示例房源链接：604 Freeman Crescent, Kingston

原始问题代码 #

Sub GetAddress()

Dim request As Object
Dim response As String
Dim html As New HTMLDocument
Dim website As String
Dim address As Variant

'读取A1单元格预设的URL
website = Range("A1")

Set request = CreateObject("MSXML2.XMLHTTP")
request.Open "Get", website, False
request.setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
request.send

response = StrConv(request.responseBody, vbUnicode)
html.body.innerHTML = response

'查找class为unsetH1的地址元素，页面中该class仅存在1个实例
address = html.getElementsByClassName("unsetH1")(0).innerText

'将地址写入B1单元格
Range("B1") = address


Dim yearbuilt As Variant


'重复读取A1单元格URL
website = Range("A1")

Set request = CreateObject("MSXML2.XMLHTTP")
request.Open "Get", website, False
request.setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
request.send

response = StrConv(request.responseBody, vbUnicode)
html.body.innerHTML = response

'该行偶发触发错误91（对象变量或With块变量未设置）、错误424（需要对象）
yearbuilt = html.getElementById("propertyDetailsSectionContentSubCon_BuiltIn").getElementsByClassName("propertyDetailsSectionContentValue")(0).innerText

'将建造年份写入C1单元格
Range("C1") = yearbuilt
End Sub

故障现象 #

• 代码运行不稳定，未修改任何内容重复测试时，偶发触发运行时错误91：对象变量或With块变量未设置
• 已确认线索：
  • 刚打开Excel后首次运行代码通常正常执行，首次运行成功后再次运行必现失效
  • 报错固定指向getElementById相关代码行，同逻辑首次正常、后续失败原因不明

故障根因 #

1. 冗余重复请求：同一URL连续发起2次HTTP请求，无意义增加被站点反爬拦截的概率，第二次请求大概率被拦截返回非完整详情页内容，自然找不到对应DOM元素
2. 请求头缺失：未携带浏览器标识（User-Agent），请求特征明显为爬虫，第二次访问就会被站点识别拦截
3. 无容错判断：直接链式调用DOM查找方法，只要任意一步没找到对应元素就直接抛出91错误，没有做存在性校验
4. 对象未释放：MSXML2.XMLHTTP、HTMLDocument对象使用后未手动重置释放，首次运行残留的对象状态会干扰后续执行
5. 编码解析不兼容：用StrConv(request.responseBody, vbUnicode)转码的方式适配性差，偶发导致HTML结构解析错乱，DOM查找失败

修复后参考代码 #

Sub GetPropertyInfo()
    Dim request As Object
    Dim html As Object
    Dim website As String
    Dim addressEl As Object, yearBuiltEl As Object, yearBuiltCon As Object
    
    ' 读取URL
    website = Trim(Range("A1").Value)
    If website = "" Then
        MsgBox "请先在A1单元格填入房源链接"
        Exit Sub
    End If
    
    ' 初始化对象，晚绑定无需额外配置库引用
    Set request = CreateObject("MSXML2.XMLHTTP.6.0")
    Set html = CreateObject("HTMLFile")
    
    ' 发起请求，补充完整请求头模拟普通浏览器访问
    request.Open "GET", website, False
    request.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/120.0.0.0 Safari/537.36"
    request.setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
    request.send
    
    ' 等待请求完成
    Do While request.readyState <> 4
        DoEvents
    Loop
    
    ' 正确加载HTML内容
    html.body.innerHTML = request.responseText
    
    ' 抓取地址，先判断元素是否存在
    Set addressEl = html.getElementsByClassName("unsetH1")(0)
    If Not addressEl Is Nothing Then
        Range("B1").Value = addressEl.innerText
    Else
        Range("B1").Value = "未找到地址信息"
    End If
    
    ' 抓取建造年份，分步判断元素存在性
    Set yearBuiltCon = html.getElementById("propertyDetailsSectionContentSubCon_BuiltIn")
    If Not yearBuiltCon Is Nothing Then
        Set yearBuiltEl = yearBuiltCon.getElementsByClassName("propertyDetailsSectionContentValue")(0)
        If Not yearBuiltEl Is Nothing Then
            Range("C1").Value = yearBuiltEl.innerText
        Else
            Range("C1").Value = "未找到建造年份信息"
        End If
    Else
        Range("C1").Value = "未找到建造年份模块"
    End If
    
    ' 释放所有对象，避免残留状态影响下次运行
    Set request = Nothing
    Set html = Nothing
    Set addressEl = Nothing
    Set yearBuiltEl = Nothing
    Set yearBuiltCon = Nothing
End Sub

额外说明 #

• 后续新增其他字段抓取时，直接在同一次请求返回的html对象里查找对应DOM即可，不需要重复发起请求
• 如果后续遇到抓取失败的情况，可以先加一行Debug.Print request.responseText打印返回的页面内容，判断是不是被反爬拦截
• 短时间内不要批量高频发起请求，否则会被站点临时封禁IP，导致所有请求都返回异常内容

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