VBAのIE自動制御について

Question

添付写真のように、URLリストがあります。
そのURLにアクセスして、横のセルにアクセスしたURLを入力したいです。

意図としてはそのURLが存在するかを確認したいためです。
ステータスコードでは区別がつかず・・・リストにあるURLとエラーページのURLが異なる為、
二つを比較すればそのURLが存在するか判断できると思いまして。。

教えてください。お願いします！

WindFaller · Accepted Answer

#4でダメでしたので、まったく別な方法を試みていますが、やはりうまく行っていません。
お急ぎのところ大変に申し訳ありません。こちらは、もう手立てがほとんど見つかりませんので、どうもスルーして下さってかまいません。トライ&エラーにするにしても、時間がかかりすぎました。

もし、信頼できる所というと、「VBレスキュー花ちゃん」なら、良いかもしれません。
私の回答は、一般的な内容で。それ自体はそんなに問題ないはずなのに、中国系サイトでは失敗するようです。

×>Final URL を知る必要なんてないと思いますから、Invalid URL だけでよいかと思います。

これが間違いだったのです。Final URL を知るというプログラムですが、それを待つのに非常に手間が掛かりすぎます。インターネット検索で、この種のものもあるようです。ただ、中国向けではありません。

実際、IE を手で開いたようにマニュアル調で試みても、URLの供給が早すぎて、ぜんぶ同じようにダメになってしまいます。それと、気がついたのは、サーバーから返ってくるコード（ステータスバーに出る文字)が、特殊な文字コードのようで、それでエラーを起こすようでもあります。せめて漢字でも出れば分かりました。

なお、こちらは、開いている限りは、これからもその都度報告を入れさせていただきます。現在は、ObjIE から、イベントを取り、相手サイトからURLをリターンしてきた時に、エラーなどが返っていないか、また、URLが正しく返ってきているか調べるという方法です。

WindFaller · Answer

追伸：

やはりタイムアウトは入れてください。待ち時間がまるで違います。Final URL を知る必要なんてないと思いますから、Invalid URL だけでよいかと思います。

Function GetWebStatus(URL As String) As String
　　Set WinHttp = New WinHttp.WinHttpRequest 
　　'CreateObject("WinHttp.WinHttpRequest.5.1")
　　 WinHttp.SetTimeouts 2000, 500, 500, 1000　　　'←ここです。

WindFaller · Answer

昨日から、ずっと調べてみましたが、
>リストにあるURLとエラーページのURLが異なる為、
>二つを比較すればそのURLが存在するか判断できると思いまして。。

おっしゃるものを作ってみましたし、成功はしましたが、何かがおかしいことに気が付きました。そこで、教えていただいたURLのサイトのHeader を取ってみましたが、Status 200-OK が出ています。その後で、別のサーバーに飛んで、エラーを出すという仕組みになっているようです。最初のログには、エラーは出てきません。それで、以下のような方法があることを知りました。

HTTP/1.1 200 OK
Server: cloudflare-nginx
----------------
HTTP/1.1 302 Found
Server: Tengine
Location: https://err.

おそらく、これはダミーかもしれません。

どうか試してみてください。なお、Excelが不調な場合は、メモリをどこかで使っていますから、一度、Excelのファイルを保存して、再度立ち上げてみてください。そこで、試行錯誤してみて、URLを送り、正しくURLが戻ってくるかということです。

今回は、なかなかハードな内容です。

'//
Sub URLCheck_WHR()
Dim URL As String
Dim c As Variant
For Each c In Range("G2", Cells(Rows.Count, 7).End(xlUp))
　　　If StrConv(c.Value, vbLowerCase) Like "http?*" And c.Offset(, 1).Value = "" Then
　　　　URL = Replace(Trim(c.Value), "https:", "http:", 1, 1, vbTextCompare)
　　　　DoEvents
　　　　c.Offset(, 1).Value = GetWebStatus(URL)
　　　End If
Next
End Sub
'
Function GetWebStatus(URL As String) As String
　　Dim WinHttp As WinHttp.WinHttpRequest '参照設定　WinHttp.WinHttpRequest.5.1
　　Set WinHttp = New WinHttp.WinHttpRequest 'CreateObject("WinHttp.WinHttpRequest.5.1")
On Error GoTo ErrHandler
　 Dim ret
　　WinHttp.Option(WinHttpRequestOption_SslErrorIgnoreFlags) = 13056 '
　　WinHttp.Open "GET", URL, False
　　'WinHttp.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
　　WinHttp.send URL　'GETリクエストを送信
　　ret = WinHttp.Option(WinHttpRequestOption_URL)
　　GetWebStatus = WinHttp.Status　'ステータスコードをセット
　　Set WinHttp = Nothing
　　Exit Function
ErrHandler:
　　GetWebStatus = "Invalid URL"
　　Set WinHttp = Nothing
End Function

そうすると、くだんのURLは、ひじょうに時間がかかる上に、最後にエラーが取れました。どこかで、タイムアウトを設けるか、On Error Resume Next で素通りさせるかしたほうがよいかもしれません。他はすんなり通るのに、ダメなものは検索にあまりにも時間が掛かりすぎます。時間の掛かったものは、いずれにしてもダメにしておいたほうがよいでしょう。

「502 Bad Gateway ゲートウェイやProxyとして動作しているサーバがリクエストを実行しようとしたら不正なレスポンスを受け取った。」と出てきました。

WindFaller · Answer

>IEのバージョンなどにかなり起因しているのでしょうか。。
ちょっと、その前に、どのような状態なのか、それを教えていただけますか。
ともかく、うまくいかないとは、起動しないということでしょうか。
まったく動かないのは、設定自体の問題か、OSや環境がまったく違うということです。
まったく動かないものを、アップしたつもりはありません。
添付の画像をみていただくと分かりますが、赤字で出てくるものがエラーですが、厳密には、その中でも動くものはあるということです。エラーの出が多すぎるからです。

そこから教えてください。
もちろん、参照設定など、一通りのことはお分かりになっているかとは思います。

また、
>ステータスコードでは区別がつかず・・・リストにあるURLとエラーページのURLが異なる為、

>二つを比較すればそのURLが存在するか判断できると思いまして。。
それはIEのことですね。調べてみないと確かなことは言えませんが、ステータスコードが、まったく区別つかないことはなかったはずです。つまり、こちらのコードでは、Status =200 は出なかったと思うのです。転送されるような仕組みになっていても、こちらのコードは飛ぶような構造にはなっていません。画像の中にある、「リダイレクトに失敗しました」ということだと思います。

VBAの初心者の方が使うようなものではない以上、あまり初歩的なことはお教えしませんので、それだけはご了解していただくようお願いします。後、こちらは、Windows10, Excel 2013, 32bit で行っています。

それと、私的なことですが、また、PC環境が不調になってきていますので、1両日中には、検査したいと思ってますが、突然、返事が途絶えることがあるかもしれません。

WindFaller · Answer

最初に、今、しばらくご質問を検討させていただいているのですが、ずばりの回答が書けない状態でいます。

ご質問内容は、ここの教えて！gooで検索すれば、かつてはうまくいったというコードが見つかるように思います。

当時は、それで良かったものの、今やってみると、大変な状態になってしまいました。おそらく、OSやソフト側のセキュリティが上がったからだと思います。

>そのURLが存在するかを確認したいためです。
というだけなら、なんとか出来ます。

>そのURLにアクセスして、横のセルにアクセスしたURLを入力したいです。
つまり、IEのLocalUrl とかを取るということだと思います。そのためのコードが必要になるのかもしれません。今の方法からは取れそうで取れません。別に作らないといけないと思います。

以下で、ともかく、OKが出るところは、何の問題もないとみなして良いと思います。
厳密には、以下のコードでは、
ElseIf objHTTP.Status >= 200 And objHTTP.Status < 300 Then
　　　↓
ElseIf objHTTP.Status = 200 Then

になります。以前はシンプルでしたが、今回、昔使っていた、URLリストでやってみたら、様々なエラーが出てきて、いろいろ手を加えて、このようなコードに変わってしまいました。どうやら、IEの設定にも影響されているようです。

Ok か、ダメだった理由が出てきます。

例
こちらは、概ね、リンク先は生きていますが、VBA側がアクセスできません。
-----------------------------------
Error 証明書のホスト名は無効か一致しません
Error 処理がタイムアウトになりました
Error サーバー名またはアドレスは解決されませんでした
Error HTTP のリダイレクト要求は失敗しました
----------------------------------

数字がついた、Error はもうだめだと思ったほうがよいです。
例
Error 404 - Not Found

参照設定はしたほうが安全です。エラーが出ても、その内容によってはアクセス可能な所あります。スピードはかなり遅いです。実験的なつもりでお使いください。改めて試して見る必要があります。

'//
Private Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long) '　　気休めスリープ

Sub URL_ErrCheck()
　Dim c As Range
　Dim objHTTP As WinHttp.WinHttpRequest　'参照設定
　Set objHTTP = New WinHttp.WinHttpRequest
　Application.DisplayAlerts = False
　　For Each c In Range("G2", Cells(Rows.Count, 7).End(xlUp))
　　　If StrConv(c.Value, vbLowerCase) Like "http?*" And c.Offset(, 1).Value <> "OK" Then
　　　　objHTTP.Open "GET", Trim(c.Value), False
　　　　Sleep 500　'0.5s スリープ
　　　　On Error Resume Next
　　　　objHTTP.send
　　　　DoEvents
　　　　 If Err <> 0 Then
　　　　　　c.Offset(, 1).Value = "Error " & Err.Description
　　　　　　Err.Clear
　　　　 ElseIf objHTTP.Status >= 200 And objHTTP.Status < 300 Then
　　　　　c.Offset(, 1).Value = "OK"
　　　　 Else
　　　　　c.Offset(, 1).Value = "Error " & objHTTP.Status & " - " & objHTTP.statusText
　　　　End If
　　　　On Error GoTo 0
　　　End If
　　Next c
　　Application.DisplayAlerts = True
End Sub

VBAのIE自動制御について

#4でダメでしたので、まったく別な方法を試みていますが、やはりうまく行っていません。

追伸：

昨日から、ずっと調べてみましたが、

>IEのバージョンなどにかなり起因しているのでしょうか。

最初に、今、しばらくご質問を検討させていただいているのですが、ずばりの回答が書けない状態でいます。

似たような質問が見つかりました

このQ&Aを見た人はこんなQ&Aも見ています

関連するカテゴリからQ&Aを探す

このQ&Aを見た人がよく見るQ&A

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング