带URL循环的Web定价Scraper出现Automation Error问题求助

以下是针对问题的优化方案，解决循环中的自动化错误并提升代码稳定性：

问题根源分析 #

• 循环内重复创建MSXML2.XMLHTTP对象未释放，资源累积触发错误
• 缺乏错误处理，单个URL请求失败或元素找不到会直接中断整个循环
• 高频连续请求可能被目标网站反爬机制拦截

优化后的代码 #

Sub FetchPrices_data()
    Dim Model As String
    Dim request As Object
    Dim response As String
    Dim html As HTMLDocument
    Dim Price As String
    Dim i As Integer
    
    ' 提前初始化HTMLDocument对象，避免重复创建
    Set html = New HTMLDocument
    
    For i = 1 To 50
        On Error Resume Next ' 启用错误捕获
        Model = Range("B" & i).Value
        
        ' 跳过空URL
        If Model = "" Then
            Range("C" & i).Value = "空URL"
            On Error GoTo 0
            GoTo NextIteration
        End If
        
        Set request = CreateObject("MSXML2.XMLHTTP")
        request.Open "GET", Model, False
        request.setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
        ' 添加浏览器请求头，降低被拦截概率
        request.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"
        
        request.send
        
        ' 检查请求状态
        If request.Status <> 200 Then
            Range("C" & i).Value = "请求失败，状态码：" & request.Status
            Set request = Nothing
            On Error GoTo 0
            GoTo NextIteration
        End If
        
        response = StrConv(request.responseBody, vbUnicode)
        html.body.innerHTML = response
        
        ' 处理价格元素不存在的情况
        Price = ""
        If html.getElementsByClassName(" Hidden ").Length > 0 Then
            Price = html.getElementsByClassName(" Hidden ").Item(0).innerText
        Else
            Price = "未找到价格元素"
        End If
        
        Range("C" & i).Value = Price
        
        ' 释放当前请求对象
        Set request = Nothing
        On Error GoTo 0
        
        ' 添加延迟，避免请求过于频繁（可根据情况调整时长）
        Application.Wait Now + TimeValue("00:00:01")
        
NextIteration:
    Next i
    
    ' 释放HTML对象
    Set html = Nothing
    MsgBox "价格抓取完成！"
End Sub

关键优化点 #

• 资源释放：每次循环后销毁MSXML2.XMLHTTP对象，避免资源泄漏
• 错误容错：单个请求失败或元素找不到时，不会中断整个循环，返回明确提示
• 反爬适配：模拟浏览器请求头，增加请求间隔，降低被网站拦截的概率
• 效率提升：复用HTMLDocument对象，减少重复初始化的开销

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