[[20170524131813]]　『既存のA列のURLをDLするシートに404と403の結果を』（繁忙マン）　ページの最後に飛ぶ

『既存のA列のURLをDLするシートに404と403の結果をB列に表示させたい』（繁忙マン）

 御世話になります。

 他所で見つけた以下の様なVBAを用いて、A列にあるURLのhtmlをダウンロードしております。
 「404 Not Found」「403 Forbidden」のときは当然に何もダウンロードされないわけですが、
 このようなダウンロードされたか否か、「404 Not Found」「403 Forbidden」だったかのステータスを
 B列に表示させる方法はないでしょうか？

 例えば、A1のURLがDLできたらB1に「〇」、A2のURLが「404 Not Found」だったらB2に「×」、
 A3のURLが「403 Forbidden」だったらB3に「△」といった方法があれば有難いなと思っております。

 DLできたら「〇」、「404 Not Found」だったら「×」、此れ以外だったら「△」でも助かります。

 何方か御支援を頂けないでしょうか。

 --------------------------------------------

 Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String,  ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long

 Sub kaitou()

     Dim FILENAME As String
     Dim Y As Long
     Dim KA As String
     Dim KB As String

     Y = 1
     KA = 0

 Do While Cells(Y, 1).Value <> ""
     url = Cells(Y, 1).Value
     KA = Right(Cells(Y, 1).Value, 4)
     KB = KA
     KB = Left(KB, 1)
     If KB <> "." Then
         FILENAME = "C:\Users\M\" & Y & "." & KA
     Else
         FILENAME = "C:\Users\M\" & Y & KA
     End If
     RE = URLDownloadToFile(0, url, FILENAME, 0, 0)
     Y = Y + 1
 Loop
 End Sub

＜使用 Excel：Excel2016、使用 OS：Windows7 ＞

 以下が参考になるだろうか？
https://oshiete.goo.ne.jp/qa/5474619.html

 なお、正常に開かれた場合、URLDownloadToFileは0を返すようだ。
（ねむねむ） 2017/05/24(水) 14:55

ご紹介のURLを試してみましたが両方ともエクセルがフリーズしてしまい
ダウンロードできるか否かとB列の表示について確認することが叶いませんでした。

皆様、引き続き宜しくお願い致します。
（繁忙マン） 2017/05/25(木) 07:11

 ダウンロードできた場合はURLDownloadToFileの返値が0になるそうなので成功はそれで判断できそうだ。
（ねむねむ） 2017/05/25(木) 09:40

 以下のようなことではどうですか？

 Option Explicit

 Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
 Dim http As Object '■追加しているので注意

 Sub test()
     Dim folderName  As String
     Dim url         As String
     Dim fileName    As String
     Dim baseName    As String
     Dim dot         As String
     Dim re          As Variant
     Dim k           As Long
     Dim status    As Long

     folderName = "C:\Users\M\"

     k = 1
     Do While Cells(k, 1).Value <> ""
         url = Cells(k, 1).Value
         baseName = Right(url, 4)
         dot = Left(baseName, 1)

         If dot <> "." Then
             fileName = folderName & k & "." & baseName
         Else
             fileName = folderName & k & baseName
         End If

         status = checkURL(url)
         If status = 200 Then
             re = URLDownloadToFile(0, url, fileName, 0, 0)
             Cells(k, 2).Value = "○"
             '' Cells(k, 3).Value = re '0が返りますね。
         Else
             Cells(k, 2).Value = status
         End If

         k = k + 1
     Loop
 End Sub

 '' url にアクセスして statusコードを得る
 Function checkURL(url As String) As Long
     If http Is Nothing Then
         Set http = CreateObject("Msxml2.XMLHTTP.6.0")
     End If
     http.Open "HEAD", url, False
     http.send
     checkURL = http.status
 End Function

 statusコードで判断して○×△にするところは、ご自分で自由に修正してください。
 なお、ファイルのダウンロード部分は、変数を変更しただけで、内容は変えていません。

（γ） 2017/05/26(金) 00:04

γさま、有難うございます。

まさにイメージしていた通りでした。
御礼申し上げます。

ただ、頂戴したものを使ったところ「404」「407」は表示されるのですが、
「403」が「404」に含まれてしまうようです。

これはやむをえない仕様もしくは対象サイトの問題なのでしょうか？

対象サイトを示せずに恐縮ですがご返信いただければ幸いです。
（繁忙マン） 2017/05/27(土) 02:59

＞「403」が「404」に含まれてしまうようです。
それはどのような根拠でそう思われるのですか？
　
HTTPサーバが返すstatusコードが404であった、
という事実をそのままシートに書いているだけだと思いますが？
何も判断は加えておりませんよ。
403であるべきだと言われても、実際404が返ってきているなら、
致し方ないと思います。

（γ） 2017/05/27(土) 07:40

403を返すとファイルの存在を認めることになるので、
404に変換して返すサーバーもあるらしいですね。
　
# ところでこちらのサーバーにつながりにくいですね。
# なにかトラブルでもあったのでしょうか。

（γ） 2017/05/27(土) 10:11

ちなみに、HEADメソッドで、ヘッダー情報だけ
要求していて、二回本体を取得していないことに、
留意して下さい。念のため。

（γ） 2017/05/27(土) 13:13

コメント返信：

[ 一覧(最新更新順) ]

[[20170524131813]] 『既存のA列のURLをDLするシートに404と403の結果を』（繁忙マン） ページの最後に飛ぶ

[[20170524131813]]　『既存のA列のURLをDLするシートに404と403の結果を』（繁忙マン）　ページの最後に飛ぶ