批量检查超链接的状态

Question

我在 excel 上有一长串 hyperlink，我想创建一个代码来检查这些 link 是否会导致错误页面或不是。

我改编了这个 post Sort dead hyperlinks in Excel with VBA?

中的代码

然而，每次我运行都是错误

"403 - Forbidden"

出现，无论 link 是否有效。

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

这是我正在使用的代码：

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

批量检查超链接的状态

Bulk check the status of an hyperlink

excel

vba

reference

hyperlink

http-status-code-403