使用VBA解析在线XML源失效问题求助

一、模拟Chrome/Edge请求头绕过检测 #

Cloudflare会通过请求头识别非浏览器请求，给MSXML6添加完整的浏览器请求头是最直接的尝试方案，核心是设置User-Agent、Accept等关键字段。

以下是可直接测试的VBA代码：

Sub FetchMI5ThreatLevel()
    Dim httpReq As MSXML2.XMLHTTP60
    Dim xmlDoc As MSXML2.DOMDocument60
    
    Set httpReq = New MSXML2.XMLHTTP60
    Set xmlDoc = New MSXML2.DOMDocument60
    
    ' 配置模拟Chrome的请求头
    httpReq.Open "GET", "https://www.mi5.gov.uk/UKThreatLevel/UKThreatLevel.xml", False
    httpReq.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"
    httpReq.setRequestHeader "Accept", "text/html,application/xhtml+xml,application/xml;q=0.9,image/avif,image/webp,*/*;q=0.8"
    httpReq.setRequestHeader "Accept-Language", "en-GB,en;q=0.5"
    httpReq.setRequestHeader "Accept-Encoding", "gzip, deflate, br"
    httpReq.setRequestHeader "Connection", "keep-alive"
    httpReq.setRequestHeader "Upgrade-Insecure-Requests", "1"
    
    ' 发送请求并处理响应
    On Error Resume Next
    httpReq.send
    On Error GoTo 0
    
    If httpReq.Status = 200 Then
        xmlDoc.LoadXML httpReq.responseText
        If xmlDoc.parseError.ErrorCode = 0 Then
            ' 提取威胁等级示例
            Dim level As String
            level = xmlDoc.SelectSingleNode("//ThreatLevel").Text
            Debug.Print "当前威胁等级：" & level
            ' 这里添加更新值班人员记录的逻辑
        Else
            Debug.Print "XML解析失败：" & xmlDoc.parseError.Reason
        End If
    Else
        Debug.Print "请求失败，状态码：" & httpReq.Status
        Debug.Print "响应内容：" & httpReq.responseText
    End If
    
    ' 释放对象
    Set httpReq = Nothing
    Set xmlDoc = Nothing
End Sub

二、关于Cloudflare验证等待的说明 #

MSXML6只是纯HTTP请求组件，没有JavaScript引擎，无法处理Cloudflare的人机验证或动态JS渲染的等待页面。如果上述请求头模拟方案仍返回403，需要换用带浏览器内核的方案：

• 可以用VBA调用Selenium自动化工具，启动Chrome/Edge浏览器访问目标XML地址，等待Cloudflare验证完成后，获取页面源码再解析。
• 这种方案需要提前安装Selenium驱动，并在VBA中引用相关库。

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