No.5ベストアンサー
- 回答日時:
#4でダメでしたので、まったく別な方法を試みていますが、やはりうまく行っていません。
お急ぎのところ大変に申し訳ありません。こちらは、もう手立てがほとんど見つかりませんので、どうもスルーして下さってかまいません。トライ&エラーにするにしても、時間がかかりすぎました。
もし、信頼できる所というと、「VBレスキュー花ちゃん」なら、良いかもしれません。
私の回答は、一般的な内容で。それ自体はそんなに問題ないはずなのに、中国系サイトでは失敗するようです。
×>Final URL を知る必要なんてないと思いますから、Invalid URL だけでよいかと思います。
これが間違いだったのです。Final URL を知るというプログラムですが、それを待つのに非常に手間が掛かりすぎます。インターネット検索で、この種のものもあるようです。ただ、中国向けではありません。
実際、IE を手で開いたようにマニュアル調で試みても、URLの供給が早すぎて、ぜんぶ同じようにダメになってしまいます。それと、気がついたのは、サーバーから返ってくるコード(ステータスバーに出る文字)が、特殊な文字コードのようで、それでエラーを起こすようでもあります。せめて漢字でも出れば分かりました。
なお、こちらは、開いている限りは、これからもその都度報告を入れさせていただきます。現在は、ObjIE から、イベントを取り、相手サイトからURLをリターンしてきた時に、エラーなどが返っていないか、また、URLが正しく返ってきているか調べるという方法です。
ご連絡遅くなり申し訳ありませんでした。
色々とご尽力頂いてとても感謝しております。
不躾な質問にも関わらずご親切にありがとうございました。
No.4
- 回答日時:
追伸:
やはりタイムアウトは入れてください。待ち時間がまるで違います。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 '←ここです。
ご丁寧に本当にありがとうございます!
ですが・・・
URLは見れるのに、Invaildでかえってくるものが多数ありまして。。。
何度も何度もすみません。。よろしくお願いします。
https://item.taobao.com/item.htm?id=544221810722 Invalid URL
https://item.taobao.com/item.htm?id=521150351467 Invalid URL
https://item.taobao.com/item.htm?id=537611811507 Invalid URL
https://item.taobao.com/item.htm?spm=2013.1.w400 … 200
https://item.taobao.com/item.htm?spm=2013.1.2014 … 200
https://item.taobao.com/item.htm?spm=2013.1.2014 … 200
https://item.taobao.com/item.htm?spm=2013.1.2014 … 200
https://item.taobao.com/item.htm?id=544196767550 Invalid URL
No.3
- 回答日時:
昨日から、ずっと調べてみましたが、
>リストにある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として動作しているサーバがリクエストを実行しようとしたら不正なレスポンスを受け取った。」と出てきました。
No.2
- 回答日時:
>IEのバージョンなどにかなり起因しているのでしょうか。
。ちょっと、その前に、どのような状態なのか、それを教えていただけますか。
ともかく、うまくいかないとは、起動しないということでしょうか。
まったく動かないのは、設定自体の問題か、OSや環境がまったく違うということです。
まったく動かないものを、アップしたつもりはありません。
添付の画像をみていただくと分かりますが、赤字で出てくるものがエラーですが、厳密には、その中でも動くものはあるということです。エラーの出が多すぎるからです。
そこから教えてください。
もちろん、参照設定など、一通りのことはお分かりになっているかとは思います。
また、
>ステータスコードでは区別がつかず・・・リストにあるURLとエラーページのURLが異なる為、
>二つを比較すればそのURLが存在するか判断できると思いまして。。
それはIEのことですね。調べてみないと確かなことは言えませんが、ステータスコードが、まったく区別つかないことはなかったはずです。つまり、こちらのコードでは、Status =200 は出なかったと思うのです。転送されるような仕組みになっていても、こちらのコードは飛ぶような構造にはなっていません。画像の中にある、「リダイレクトに失敗しました」ということだと思います。
VBAの初心者の方が使うようなものではない以上、あまり初歩的なことはお教えしませんので、それだけはご了解していただくようお願いします。後、こちらは、Windows10, Excel 2013, 32bit で行っています。
それと、私的なことですが、また、PC環境が不調になってきていますので、1両日中には、検査したいと思ってますが、突然、返事が途絶えることがあるかもしれません。
ご丁寧にありがとうございます。。
私が知りたいURLが、中国のサイトなのですが・・・
「https://err.taobao.com/error1.html?c=404&u=https …」
例えばこれを入れていたら、OKと出てしまいます。
これはOKエラーページなのですが。。。
ですのでステータスを返してもOKになってしまっています。。。
説明不足で申し訳ございません。
No.1
- 回答日時:
最初に、今、しばらくご質問を検討させていただいているのですが、ずばりの回答が書けない状態でいます。
ご質問内容は、ここの教えて!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
ありがとうございます!ですが。。。うまくいきません。。
おっしゃるとおりにIEのバージョンなどにかなり起因しているのでしょうか。。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- JavaScript Q&Aの掲示板を作成していてヤフー知恵袋やgoo質問のように質問ごとにURLを生成したい 5 2023/08/04 01:22
- その他(暮らし・生活・行事) → ※このメールは、ファミマTカードをファミペイに登録されたことがある会員様にお送りしております。す 4 2023/05/03 12:24
- その他(趣味・アウトドア・車) アマチュア無線の「村」まで入った「市郡区番号リスト」を探しています 4 2022/08/27 07:07
- その他(インターネット接続・インフラ) ブラウザにIPアドレス入力した時 1 2022/06/16 19:08
- その他(ブラウザ) Amazonに掲載されている図書のURLについて 2 2022/12/13 10:31
- フリーソフト 画像貼り付け、URLに飛べる軽いメモ帳 3 2022/05/12 07:42
- YouTube 複数のYouTube動画を1つのQRコードにまとめることは可能ですか? 再生リストを作ってそのURL 2 2022/07/27 22:20
- その他(メールソフト・メールサービス) メールアプリ spark にauメールが入れられない!!! 1 2022/08/19 23:51
- JavaScript [Java] Edgeでのアドレスバー非表示について 3 2022/04/20 17:51
- YouTube YouTubeの設定について詳しい方教えてください。 1 2022/10/08 06:32
このQ&Aを見た人はこんなQ&Aも見ています
関連するカテゴリからQ&Aを探す
おすすめ情報
このQ&Aを見た人がよく見るQ&A
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
UserForm1.Showでエラーになり...
-
エクセル関数を教えてください
-
String""から型'Double'への変...
-
お助けください!VBAのファイル...
-
VBAでfunctionを利用しようとし...
-
インポート時のエラー「データ...
-
マクロで"#N/A"のエラー行を削...
-
ApplicationとWorksheetFunctio...
-
VBA データ(特定値)のある最...
-
実行時エラー 438 の解決策をお...
-
【VB.NET】 パワポ操作を非表示で
-
文字列内で括弧を使うには
-
ASPで、変数名に、変数を入れら...
-
マクロの「SaveAs」でエラーが...
-
VBスクリプトでIEの404 not fou...
-
変数にするとエラーになる理由は?
-
「実行時エラー '3167' レコー...
-
実行時エラー'-2147467259(8000...
-
【VBA】ワークブックを開く時に...
-
ACCESSで値を代入できないとは?
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
UserForm1.Showでエラーになり...
-
String""から型'Double'への変...
-
VBAでfunctionを利用しようとし...
-
お助けください!VBAのファイル...
-
文字列内で括弧を使うには
-
実行時エラー 438 の解決策をお...
-
マクロで"#N/A"のエラー行を削...
-
On ErrorでエラーNoが0
-
エクセルVBA 「On Error GoTo...
-
VBA データ(特定値)のある最...
-
実行時エラー'-2147467259(8000...
-
【VBA】ワークブックを開く時に...
-
VBでSQL文のUPDATE構文を使った...
-
ACCESSで値を代入できないとは?
-
マクロの「SaveAs」でエラーが...
-
Excel vbaについての質問
-
インポート時のエラー「データ...
-
Filter関数を用いた結果、何も...
-
「実行時エラー '3167' レコー...
-
バッチファイルで、あるスクリ...
おすすめ情報