VBA中MSXML2.serverXMLHTTP.6.0抓取亚马逊面包屑失败如何解决？

我编写了一段VBA脚本，通过XML HTTP请求抓取亚马逊商品页的面包屑信息。使用MSXML2.XMLHTTP.6.0时脚本运行正常，但切换为MSXML2.ServerXMLHTTP.6.0后彻底失效。由于计划在脚本中使用代理，必须坚持使用MSXML2.ServerXMLHTTP.6.0。

当前遇到的问题：

• 打印.responseText时显示乱码内容（如：??GN?!v:h??_??Og<]?????X ?6??'o??F??6 ?uh????x?r???????sP??????????[B??k????]??????yC????'???L???????,*?Z????? ?vX ?c?q ?j??????K?|???P 7??k?y?<;;?>????a?*P1????w???[?T?/f?? ?7?gn??V<E?Z??6t:??1??????E'v?1?? ?w??+??????-aD????wy?）
• 脚本抛出Object Variable or With block variable not set错误

运行正常的MSXML2.XMLHTTP.6.0代码：

Option Explicit
Sub GrabInfo()
    Const Url$ = "https://www.amazon.com/gp/product/B00FQT4LX2?th=1"
    Dim oHttp As Object, Html As HTMLDocument, breadCrumbs$

    Set Html = New HTMLDocument
    Set oHttp = CreateObject("MSXML2.XMLHTTP.6.0")

    With oHttp
        .Open "GET", Url, True
        .setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/88.0.4324.150 Safari/537.36"
        .send
        While .readyState < 4: DoEvents: Wend
        MsgBox "Status code: " & .Status
        Html.body.innerHTML = .responseText
        breadCrumbs = Html.querySelector("#wayfinding-breadcrumbs_feature_div")
        MsgBox breadCrumbs
    End With
End Sub

报错的MSXML2.ServerXMLHTTP.6.0代码：

Option Explicit
Sub GrabInfo()
    Const Url$ = "https://www.amazon.com/gp/product/B00FQT4LX2?th=1"
    Dim oHttp As Object, Html As HTMLDocument, breadCrumbs$

    Set Html = New HTMLDocument
    Set oHttp = CreateObject("MSXML2.ServerXMLHTTP.6.0")

    With oHttp
        .Open "GET", Url, True
        .setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/88.0.4324.150 Safari/537.36"
        .send
        While .readyState < 4: DoEvents: Wend
        MsgBox "Status code: " & .Status
        Html.body.innerHTML = .responseText
        breadCrumbs = Html.querySelector("#wayfinding-breadcrumbs_feature_div")
        MsgBox breadCrumbs
    End With
End Sub

问题核心是ServerXMLHTTP不会自动处理Gzip压缩响应，且缺少必要请求头导致亚马逊返回非预期内容。以下是修复方案：

1. 核心修复点 #

• 添加Accept-Encoding请求头，明确告知服务器接受Gzip压缩
• 手动解压Gzip格式的响应内容
• 补充完整请求头模拟真实浏览器行为
• 增加空值判断避免元素不存在引发的错误

2. 修复后的代码（依赖Shell控件解压） #

Option Explicit
' 需提前引用：Microsoft HTML Object Library、Microsoft Shell Controls And Automation
Sub GrabInfoWithServerXMLHTTP()
    Const Url$ = "https://www.amazon.com/gp/product/B00FQT4LX2?th=1"
    Dim oHttp As Object, Html As HTMLDocument, breadCrumbs As Object
    Dim stream As ADODB.stream, shell As Shell32.Shell
    Dim tempFolder As String, tempFile As String
    
    Set Html = New HTMLDocument
    Set oHttp = CreateObject("MSXML2.ServerXMLHTTP.6.0")
    Set stream = New ADODB.stream
    Set shell = New Shell32.Shell
    
    ' 创建临时文件夹用于解压
    tempFolder = Environ("TEMP") & "\AmazonTemp_" & Format(Now, "YYYYMMDDHHMMSS")
    MkDir tempFolder
    tempFile = tempFolder & "\response.gz"
    
    With oHttp
        .Open "GET", Url, True
        ' 补充完整请求头
        .setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/88.0.4324.150 Safari/537.36"
        .setRequestHeader "Accept", "text/html,application/xhtml+xml,application/xml;q=0.9,image/avif,image/webp,*/*;q=0.8"
        .setRequestHeader "Accept-Language", "en-US,en;q=0.5"
        .setRequestHeader "Accept-Encoding", "gzip, deflate, br"
        .setRequestHeader "Connection", "keep-alive"
        .setRequestHeader "Upgrade-Insecure-Requests", "1"
        
        .send
        While .readyState < 4: DoEvents: Wend
        
        ' 检查请求状态
        If .Status <> 200 Then
            MsgBox "请求失败，状态码：" & .Status
            GoTo Cleanup
        End If
        
        ' 将二进制响应写入临时压缩文件
        stream.Type = adTypeBinary
        stream.Open
        stream.Write .responseBody
        stream.SaveToFile tempFile, adSaveCreateOverWrite
        stream.Close
        
        ' 解压Gzip文件到临时文件夹
        shell.Namespace(tempFolder).CopyHere shell.Namespace(tempFile).Items, 16
        
        ' 读取解压后的HTML内容
        stream.Type = adTypeText
        stream.Charset = "UTF-8"
        stream.Open
        stream.LoadFromFile tempFolder & "\response"
        Html.body.innerHTML = stream.ReadText
        stream.Close
    End With
    
    ' 获取面包屑并判断元素是否存在
    Set breadCrumbs = Html.querySelector("#wayfinding-breadcrumbs_feature_div")
    If Not breadCrumbs Is Nothing Then
        MsgBox breadCrumbs.innerText
    Else
        MsgBox "未找到面包屑元素"
    End If

Cleanup:
    ' 清理临时文件和文件夹
    On Error Resume Next
    Kill tempFile
    Kill tempFolder & "\response"
    RmDir tempFolder
    On Error GoTo 0
    
    ' 释放对象
    Set oHttp = Nothing
    Set Html = Nothing
    Set stream = Nothing
    Set shell = Nothing
End Sub

3. 替代方案（依赖.NET Framework解压，无需Shell控件） #

Option Explicit
' 需提前引用：Microsoft HTML Object Library、Microsoft ActiveX Data Objects 6.1 Library
Sub GrabInfoWithServerXMLHTTP_SimpleUnzip()
    Const Url$ = "https://www.amazon.com/gp/product/B00FQT4LX2?th=1"
    Dim oHttp As Object, Html As HTMLDocument, breadCrumbs As Object
    Dim streamIn As ADODB.stream, streamOut As ADODB.stream
    Dim gzipStream As Object
    
    Set Html = New HTMLDocument
    Set oHttp = CreateObject("MSXML2.ServerXMLHTTP.6.0")
    Set streamIn = New ADODB.stream
    Set streamOut = New ADODB.stream
    
    With oHttp
        .Open "GET", Url, True
        ' 补充请求头
        .setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/88.0.4324.150 Safari/537.36"
        .setRequestHeader "Accept", "text/html,application/xhtml+xml,application/xml;q=0.9,image/avif,image/webp,*/*;q=0.8"
        .setRequestHeader "Accept-Language", "en-US,en;q=0.5"
        .setRequestHeader "Accept-Encoding", "gzip"
        .setRequestHeader "Connection", "keep-alive"
        .setRequestHeader "Upgrade-Insecure-Requests", "1"
        
        .send
        While .readyState < 4: DoEvents: Wend
        
        If .Status <> 200 Then
            MsgBox "请求失败，状态码：" & .Status
            GoTo Cleanup
        End If
        
        ' 加载二进制响应
        streamIn.Type = adTypeBinary
        streamIn.Open
        streamIn.Write .responseBody
        streamIn.Position = 0
        
        ' 使用.NET GzipStream解压
        Set gzipStream = CreateObject("System.IO.Compression.GZipStream")
        gzipStream.Initialize(streamIn, 1) ' 1代表解压模式
        
        ' 读取解压后的文本内容
        streamOut.Type = adTypeText
        streamOut.Charset = "UTF-8"
        streamOut.Open
        gzipStream.CopyTo(streamOut)
        
        Html.body.innerHTML = streamOut.ReadText
    End With
    
    ' 获取并显示面包屑
    Set breadCrumbs = Html.querySelector("#wayfinding-breadcrumbs_feature_div")
    If Not breadCrumbs Is Nothing Then
        MsgBox breadCrumbs.innerText
    Else
        MsgBox "未找到面包屑元素"
    End If

Cleanup:
    ' 释放资源
    streamIn.Close
    streamOut.Close
    Set oHttp = Nothing
    Set Html = Nothing
    Set streamIn = Nothing
    Set streamOut = Nothing
    Set gzipStream = Nothing
End Sub

• ServerXMLHTTP与XMLHTTP的核心差异：前者不会自动处理压缩响应，必须手动处理Gzip解压
• 完整请求头是避免亚马逊返回异常内容的关键，需模拟真实浏览器的请求特征
• 对querySelector返回值做空值判断，可有效避免Object Variable or With block variable not set错误

内容的提问来源于stack exchange，提问作者robots.txt