VBA使用ServerXMLHTTP请求Redfin页面返回部分响应及browserid提取问题

根本原因 #

MSXML2.XMLHTTP基于WinINet内核，会复用系统浏览器的会话缓存、Cookie存储，自动处理站点的反爬会话校验；而MSXML2.ServerXMLHTTP基于WinHTTP内核，默认是无状态的，不会自动处理Cookie、继承会话，Redfin站点的反爬策略会校验合法会话标识，无有效标识时仅返回包含基础地址的精简页面，因此无法提取到builder name字段。

你提到的browserid不一致是正常现象：站点会给每个独立会话分配唯一的browserid，你本地浏览器的会话和VBA中XMLHTTP发起的是两个完全独立的会话，id本身就不需要一致，只要在VBA的请求链路中使用当前会话生成的合法id即可。

解决方案 #

对ServerXMLHTTP请求做以下修改即可拿到完整响应：

1. 补全标准浏览器请求头，避免被反爬识别
2. 手动携带当前会话的Cookie，或直接提取响应正文里的__rfBrowserId带入请求头
3. 优先使用同步请求调试，避免异步状态判断异常导致响应截断

修改后可用代码 #

Sub GrabPropertyInfoWithServerXMLHTTP()
    Const siteLink$ = "https://www.redfin.com/TX/Austin/604-Amesbury-Ln-78752/unit-2/home/171045975"

    Dim oPost As Object, oData As Object, Html As HTMLDocument
    Dim jsonObject As Object, jsonStr As Object, propertyMainRaw$
    Dim itemStr As Variant, sResp As String, oElem As Object
    Dim propertyContainer As Object, propertyMain As Object
    Dim Rxp As Object, browserId As Object, cookieStr As String
    
    Set Html = New HTMLDocument
    Set Rxp = CreateObject("VBScript.RegExp")
    
    ' 第一次请求拿当前会话的browserid
    With CreateObject("MSXML2.ServerXMLHTTP.6.0")
        .Open "GET", siteLink, False
        ' 补全标准请求头模拟真实浏览器
        .setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/118.0.0.0 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", "zh-CN,zh;q=0.8,en-US;q=0.5,en;q=0.3"
        .setRequestHeader "Connection", "keep-alive"
        .send
        sResp = .responseText
        
        ' 提取browserid拼接Cookie
        With Rxp
            .Global = True
            .Pattern = "window.__rfBrowserId=""(.*?)"";"
            .MultiLine = True
            Set browserId = .Execute(sResp)
        End With
        cookieStr = "browserid=" & browserId(0).submatches(0) & ";"
        
        ' 第二次请求携带Cookie获取完整响应
        .Open "GET", siteLink, False
        .setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/118.0.0.0 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", "zh-CN,zh;q=0.8,en-US;q=0.5,en;q=0.3"
        .setRequestHeader "Connection", "keep-alive"
        .setRequestHeader "Cookie", cookieStr
        .send
        sResp = .responseText
        Html.body.innerHTML = sResp
    End With

    Debug.Print "Street address: " & Html.querySelector("h1.homeAddress > .street-address").innerText
    
    With Rxp
        .Global = True
        .Pattern = "reactServerState\.InitialContext = (.*);"
        .MultiLine = True
        Set jsonStr = .Execute(sResp)
    End With
    
    itemStr = jsonStr(0).submatches(0)
    Set jsonObject = JsonConverter.ParseJson(itemStr)
    Set propertyMain = jsonObject("ReactServerAgent.cache")("dataCache")("/stingray/api/home/details/mainHouseInfoPanelInfo")("res")
    propertyMainRaw = Replace(propertyMain("text"), "{}&&", "")

    On Error Resume Next
    Set propertyContainer = JsonConverter.ParseJson(propertyMainRaw)("payload")("mainHouseInfo")("amenitiesInfo")("superGroups")
    On Error GoTo 0

    If Not propertyContainer Is Nothing Then
        For Each oElem In propertyContainer
            For Each oPost In oElem("amenityGroups")
                If InStr(oPost("groupTitle"), "Building Information") > 0 Then
                    For Each oData In oPost("amenityEntries")
                        If InStr(oData("amenityName"), "Builder Name") > 0 Then
                            Debug.Print "Builder Name: " & oData("amenityValues")(1)
                        End If
                    Next oData
                End If
            Next oPost
        Next oElem
    End If
End Sub

注意事项 #

• 运行前需要提前引用Microsoft HTML Object Library，且已正确导入VBA-JSON工具
• 不要高频发起请求，避免被站点封禁IP

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