Excel VBA URL重定向检测宏误判200而非301的问题排查

问题描述 #

原宏用于检测B列URL的有效性与重定向状态，C列输出状态信息，D列输出重定向目标URL。但部分三星URL（如https://www.samsung.com/us/support/troubleshooting/TSG01003149/、https://www.samsung.com/us/support/answer/ANS00080450/）实际为301永久重定向，宏却返回200状态码，修改WinHttpRequestOption_EnableRedirects参数为True/False均无法解决该问题。

原因分析 #

1. User-Agent限制：WinHttpRequest默认的请求标识并非浏览器类型，三星服务器可能针对此类非浏览器UA直接返回200响应，而非真实的301重定向状态。
2. 请求缓存干扰：WinHttpRequest默认开启HTTP缓存机制，若此前请求过目标URL并得到200响应，后续请求会直接读取缓存结果，忽略服务器返回的真实301状态。

修正方案 #

1. 模拟浏览器请求头：设置符合浏览器标准的User-Agent，触发服务器返回真实响应。
2. 禁用请求缓存：强制每次请求直接与服务器交互，避免缓存干扰。
3. 增强重定向检测：即使状态码为200，也检查响应头中的Location字段，覆盖服务器返回200但附带重定向信息的特殊情况。

修正后代码 #

Sub CheckURLValidity()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim url As String
    Dim httpRequest As Object
    Dim responseCode As Long
    Dim locationHeader As String

    Set ws = ActiveSheet
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

    Set httpRequest = CreateObject("WinHttp.WinHttpRequest.5.1")
    
    ' 禁用重定向跟随与HTTP缓存
    httpRequest.Option(WinHttpRequestOption_EnableRedirects) = False
    httpRequest.Option(WinHttpRequestOption_EnableHttpCache) = False

    For i = 2 To lastRow
        url = ws.Cells(i, 2).Value
        
        If Len(url) > 0 Then
            On Error Resume Next ' 捕获请求异常，避免宏中断
            httpRequest.Open "GET", url, False
            ' 设置模拟Chrome浏览器的User-Agent
            httpRequest.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"
            httpRequest.Send
            
            responseCode = httpRequest.Status
            locationHeader = httpRequest.getResponseHeader("Location")
            On Error GoTo 0 ' 恢复默认错误处理

            ' 优先检查Location头，覆盖服务器返回200但附带重定向的情况
            If Len(locationHeader) > 0 Then
                ws.Cells(i, 3).Value = "301 Moved Permanently"
                ws.Cells(i, 4).Value = locationHeader
            Else
                Select Case responseCode
                    Case 200
                        ws.Cells(i, 3).Value = "200 Valid"
                    Case 404
                        ws.Cells(i, 3).Value = "404 Not Found"
                    Case 301
                        ws.Cells(i, 3).Value = "301 Moved Permanently"
                        ws.Cells(i, 4).Value = locationHeader
                    Case 302
                        ws.Cells(i, 3).Value = "302 Found"
                        ws.Cells(i, 4).Value = locationHeader
                    Case 307
                        ws.Cells(i, 3).Value = "307 Temporary Redirect"
                        ws.Cells(i, 4).Value = locationHeader
                    Case 308
                        ws.Cells(i, 3).Value = "308 Permanent Redirect"
                        ws.Cells(i, 4).Value = locationHeader
                    Case Else
                        ws.Cells(i, 3).Value = responseCode & " - Other"
                        ws.Cells(i, 4).Value = locationHeader
                End Select
            End If
        End If
    Next i

    Set httpRequest = Nothing
End Sub

关键修改说明 #

• 新增httpRequest.Option(WinHttpRequestOption_EnableHttpCache) = False：禁用HTTP缓存，确保每次请求获取服务器最新响应。
• 添加SetRequestHeader设置浏览器UA：模拟真实浏览器请求，触发服务器返回真实重定向状态。
• 前置检查Location头：即使状态码显示为200，只要存在重定向目标地址，就判定为301重定向。
• 增加异常捕获：避免单个URL请求失败导致整个宏运行中断。

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