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的结果），则发生错误< / p>

因此，显然它没有遵循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(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

批量检查超链接的状态

1 个答案: