批量检查超链接的状态

Question

我在 excel 上有一个很长的超链接列表，我想创建一个代码来检查这些链接是否会驱动到错误页面。

我改编了这篇帖子Sort dead hyperlinks in Excel with VBA?的代码

但是每次运行都会报错

“403 - 禁止”

出现，无论链接是否有效。

我希望代码执行的是在下一个单元格中写入是否会导致 404 页面。 我想问题是缺少授权 excel 跟随超链接的额外行，但我想不出如何解决这个问题。

这是我正在使用的代码：

Sub CheckHyperlinks()    
    Dim oColumn As Range

    Dim oCell As Range
    For Each oCell In Selection    
        If oCell.Hyperlinks.Count > 0 Then   
            Dim oHyperlink As Hyperlink
            Set oHyperlink = oCell.Hyperlinks(1) ' I assume only 1 hyperlink per cell

            Dim strResult As String
            strResult = GetResult(oHyperlink.Address)
            oCell.Offset(0, 1).Value = strResult
        End If
    Next oCell
End Sub

Private Function GetResult(ByVal strUrl As String) As String
    On Error GoTo ErrorHandler

    Dim oHttp As New MSXML2.XMLHTTP60

    oHttp.Open "HEAD", strUrl, False
    oHttp.send

    GetResult = oHttp.Status & " " & oHttp.statusText

    Exit Function

ErrorHandler:
    GetResult = "Error: " & Err.Description  
End Function

Answer 1

例如，如果您尝试访问http://www.google.com，但它在https://www.google.com 上有效（您可以使用Debug.Print GetResult("https://www.google.com" 对其进行测试，结果是200 OK）

所以它显然不遵循 Google 设置的 http:// 到 https:// 的重定向。

或者使用WinHttpRequest object 代替GetResult：

Private Function GetResultExtended(ByVal strUrl As String) As String
    On Error GoTo ErrorHandler

    Dim xhr As Object
    Set xhr = CreateObject("WinHttp.WinHttpRequest.5.1")

    xhr.Option(6) = True 'follow redirects
    xhr.Open "HEAD", strUrl, False
    xhr.send

    GetResultExtended = xhr.Status & " " & xhr.statusText
    Exit Function

ErrorHandler:
    GetResultExtended = "Error: " & Err.Description
End Function

如果您在函数上方定义以下WinHttpRequestOption enumeration，您也可以使用xhr.Option(WinHttpRequestOption_EnableRedirects)，而不是xhr.Option(6)：

Option Explicit

Private Enum WinHttpRequestOption
    WinHttpRequestOption_UserAgentString
    WinHttpRequestOption_URL
    WinHttpRequestOption_URLCodePage
    WinHttpRequestOption_EscapePercentInURL
    WinHttpRequestOption_SslErrorIgnoreFlags
    WinHttpRequestOption_SelectCertificate
    WinHttpRequestOption_EnableRedirects
    WinHttpRequestOption_UrlEscapeDisable
    WinHttpRequestOption_UrlEscapeDisableQuery
    WinHttpRequestOption_SecureProtocols
    WinHttpRequestOption_EnableTracing
    WinHttpRequestOption_RevertImpersonationOverSsl
    WinHttpRequestOption_EnableHttpsToHttpRedirects
    WinHttpRequestOption_EnablePassportAuthentication
    WinHttpRequestOption_MaxAutomaticRedirects
    WinHttpRequestOption_MaxResponseHeaderSize
    WinHttpRequestOption_MaxResponseDrainSize
    WinHttpRequestOption_EnableHttp1_1
    WinHttpRequestOption_EnableCertificateRevocationCheck
End Enum