我有一个电子表格,其中包含数百个链接,这些链接指向可以通过Web访问的服务器(具有身份验证)。我一直在寻找电子表格中链接检查器的解决方案,该解决方案可以告诉我哪些链接断开,哪些可以。破损是指该网站根本没有被调用。
我在网上发现了各种解决方案,但都不适合我。我对此感到困惑...
我尝试使用并弄清楚的一个示例在下面重新发布。
在逐步阅读代码后,我意识到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
如有任何关于错误或正确的建议,我们将不胜感激!
最佳答案
几个可能的原因。
您是说oHttp.Open "GET", strUrl, False
而不是oHttp.Open "HEAD", strUrl, False
吗?
也许MSXML2.XMLHTTP30不可用?您可以将MSXML2.XMLHTTPX的实例声明为早绑定或后绑定,这可能会影响您要使用哪个版本与可用版本(示例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的代码将正确重定向。
关于vba - XMLHTTP.send请求带回“Nothing”,我们在Stack Overflow上找到一个类似的问题:https://stackoverflow.com/questions/11647297/