XMLHTTP.send请求带回“没什么”

时间:2012-07-25 10:02:25

标签: excel vba excel-vba excel-2010

我有一个电子表格,其中有数百个指向可通过网络访问的服务器(带身份验证)的链接。我一直在电子表格中搜索链接检查器的解决方案,它会告诉我哪些链接坏了,哪些链接没问题。通过破坏我的意思是该网站根本没有被调用。

我在网络上找到了各种解决方案,但这些解决方案对我来说都不起作用。我为此感到困惑......

我尝试使用并弄清楚的一个例子在下面重新发布。

当我逐步完成代码时,我逐渐意识到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

对于可能出错或对错的任何建议都非常感谢!

1 个答案:

答案 0 :(得分:1)

有几种可能的原因..

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

    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
    

    <强> EDIT2:

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

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

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