时间戳

首页 > 解决方案 > 批量检查超链接的状态

excel - 批量检查超链接的状态

问题描述

我在 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

标签： excelvbahyperlinkreferencehttp-status-code-403

解决方案

例如，如果您尝试访问http://www.google.com但它可以正常工作，则会发生错误https://www.google.com（您可以使用Debug.Print GetResult("https://www.google.com"您获得200 OK的结果对其进行测试）

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

或者使用WinHttpRequest 对象，如下所示，而不是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 枚举，您xhr.Option(6)也可以使用：xhr.Option(WinHttpRequestOption_EnableRedirects)

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

推荐阅读