2

Web 経由でアクセスできる (認証付きの) サーバーを指す数百のリンクを含むスプレッドシートがあります。どのリンクが壊れていて、どのリンクが問題ないかを教えてくれるスプレッドシートのリンク チェッカーの解決策を探していました。壊れているとは、Web サイトがまったく呼び出されないことを意味します。

Web で見つけたさまざまな解決策がありますが、どれもうまくいきません。私はこれに困惑しています...

私が使用して把握しようとした 1 つの例を以下に再掲します。

コードを進めていくと、oHTTP.sendリクエストによって「何も返されない」ことがわかりました。リンクが機能するかどうかに関係なく、スプレッドシート内のすべてのリンクに対してこれを行います。

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

何が間違っているか、または正しいかについての提案は、非常に高く評価されています!

4

1 に答える 1

2

いくつかの考えられる原因..

  1. oHttp.Open "GET", strUrl, Falseの代わりということoHttp.Open "HEAD", strUrl, Falseですか？
  2. おそらく 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

EDIT2：

MSXML2.XMLHTTP はリダイレクトを許可します (ただし、MSXML2.ServerXMLHTTP は許可しないと思います)。リダイレクトがクロスドメイン、クロスポートなどであるかどうかに応じて、リダイレクトが許可/禁止されます (詳細はこちらを参照してください http://msdn.microsoft.com/en-us/library/ms537505(v=vs.85).aspx )

ログイン ページへのリダイレクトはクロスドメインであるため、IE ゾーン ポリシーが実装されます。IE/Tools/Internet Options/Security/Custom Level を開き、「Access data sources across domain」を ENABLED に変更します。

元の OP のコードが適切にリダイレクトされるようになりました。

于 2012-07-25T21:42:11.067 に答える