vba - XMLHTTP.send 请求返回 "Nothing"

Question

我有一个电子表格，其中有数百个链接，这些链接指向可以通过网络访问的服务器(带有身份验证)。我一直在寻找电子表格中链接检查器的解决方案，它可以告诉我哪些链接已损坏，哪些链接正常。我所说的损坏是指该网站根本没有被调用。

我在网上找到了各种解决方案，但没有一个对我有用。我对此感到困惑...

下面重新发布了我尝试使用并找出的一个示例。

当我逐步执行代码时，我开始意识到 oHTTP.send 请求返回“Nothing”。它对电子表格中的所有链接都执行此操作，无论链接是否有效。

Public Function CheckHyperlink(ByVal strUrl As String) As Boolean

    Dim oHttp As New MSXML2.XMLHTTP30

    On Error GoTo ErrorHandler
    oHttp.Open "HEAD", strUrl, False
    oHttp.send

    If Not oHttp.Status = 200 Then CheckHyperlink = False Else CheckHyperlink = True

    Exit Function

ErrorHandler:
    CheckHyperlink = False
End Function

任何关于可能错误或正确的建议，我们都非常感激!

Answer 1

几个可能的原因..

1. 您的意思是 oHttp.Open "GET", strUrl, False 而不是 oHttp.Open "HEAD", strUrl, False 吗？
2. 也许 MSXML2.XMLHTTP30 不可用？您可以将 MSXML2.XMLHTTPX 的实例声明为早期绑定(bind)或后期绑定(bind)，这可能会影响您要使用的版本与可用版本(示例 http://word.mvps.org/FAQs/InterDev/EarlyvsLateBinding.htm )

例如

Option Explicit

'Dim oHTTPEB As New XMLHTTP30 'For early binding enable reference Microsoft XML, v3.0
Dim oHTTPEB As New XMLHTTP60 'For early binding enable reference Microsoft XML, v6.0

Sub Test()
Dim chk1 As Boolean
Dim chk2 As Boolean

 chk1 = CheckHyperlinkLB("http://stackoverflow.com/questions/11647297/xmlhttp-send-request-brings-back-nothing")

 chk2 = CheckHyperlinkEB("http://stackoverflow.com/questions/11647297/xmlhttp-send-request-brings-back-nothing")

End Sub

Public Function CheckHyperlinkLB(ByVal strUrl As String) As Boolean
Dim oHTTPLB As Object

'late bound declaration of MSXML2.XMLHTTP30
    Set oHTTPLB = CreateObject("Msxml2.XMLHTTP.3.0")

    On Error GoTo ErrorHandler
    oHTTPLB.Open "GET", strUrl, False
    oHTTPLB.send

    If Not oHTTPLB.Status = 200 Then CheckHyperlinkLB = False Else CheckHyperlinkLB = True

    Set oHTTPLB = Nothing
    Exit Function

ErrorHandler:
    Set oHTTPLB = Nothing
    CheckHyperlinkLB = False
End Function


Public Function CheckHyperlinkEB(ByVal strUrl As String) As Boolean
'early bound declaration of MSXML2.XMLHTTP60

    On Error GoTo ErrorHandler
    oHTTPEB.Open "GET", strUrl, False
    oHTTPEB.send

    If Not oHTTPEB.Status = 200 Then CheckHyperlinkEB = False Else CheckHyperlinkEB = True

    Set oHTTPEB = Nothing
    Exit Function

ErrorHandler:
    Set oHTTPEB = Nothing
    CheckHyperlinkEB = False
End Function

编辑:

我通过在浏览器中打开来测试OP的链接，现在我发现它重定向到登录页面，所以这是我正在测试的不同链接。它可能会失败，因为 oHttp 对象尚未设置为允许重定向。我知道可以使用下面的代码为 WinHttp.WinHttpRequest.5.1 设置重定向。我需要调查这是否也适用于 MSXML2.XMLHTTP30。

Option Explicit

Sub Test()
Dim chk1 As Boolean

 chk1 = CheckHyperlink("http://portal.emilfrey.ch/portal/page/portal/toyota/30_after_sales/20_ersatzteile%20und%20zubeh%C3%B6r/10_zubeh%C3%B6r/10_produktbezogene%20informationen/10_aussen/10_felgen/10_asa-pr%C3%BCfberichte/iq/tab1357333/iq%20016660.pdf")

End Sub


Public Function CheckHyperlink(ByVal strUrl As String) As Boolean
Dim GetHeader As String

    Const WinHttpRequestOption_EnableRedirects = 6
    Dim oHttp As Object

    Set oHttp = CreateObject("WinHttp.WinHttpRequest.5.1")

    On Error GoTo ErrorHandler
    oHttp.Option(WinHttpRequestOption_EnableRedirects) = True
    oHttp.Open "HEAD", strUrl, False
    oHttp.send

    If Not oHttp.Status = 200 Then
        CheckHyperlink = False
    Else
        GetHeader = oHttp.getAllResponseHeaders()
        CheckHyperlink = True

    End If

    Exit Function

ErrorHandler:
    CheckHyperlink = False
End Function

编辑2:

MSXML2.XMLHTTP 确实允许重定向(尽管我相信 MSXML2.ServerXMLHTTP 不允许)。允许/禁止重定向取决于重定向是否跨域、跨端口等(请参阅此处的详细信息 http://msdn.microsoft.com/en-us/library/ms537505(v=vs.85).aspx )

由于登录页面的重定向是跨域的，因此实现IE区域策略。打开 IE/工具/Internet 选项/安全/自定义级别并将“跨域访问数据源”更改为“启用”

原始OP的代码现在将正确重定向。