EXCEL VBAでたくさんのURLの一覧からHTTPレスポンスコードを取得したい。

質問

VBA初心者です。
EXCEL VBAでプログラミングの練習をしています。

シート名：一覧
URL記入セル：A1～A100
結果を記入するセル：B1～B100
があり、URL記入セルに入力されているURLにアクセスし
レスポンスコードを（404とか200とか）B列に書き出す
というのを実行できるコードの書き方を教えてください。
（1週間取り組んでいますがまだできません・・・）
サンプルコードを直接改定頂けると最高です。

宜しくお願いします。

回答No.1

kenpon24 · ベストアンサー

こんな感じでしょうかね。たぶん。。。

Sub Sample()

　　Dim i As Long
　　Dim bottom As Long

　　bottom = Range("A65536").End(xlUp).Row

　　For i = 1 To bottom

　　　　Range("B" & i) = GetWebStatus(Range("A" & i))

　　Next i

End Sub

Function GetWebStatus(URL As String) As String

　　Dim WinHttp As Object

　　Set WinHttp = CreateObject("WinHttp.WinHttpRequest.5.1")

On Error GoTo INVALID

　　WinHttp.Open "GET", URL, False
　　WinHttp.send

　　GetWebStatus = WinHttp.Status

　　Set WinHttp = Nothing

　　Exit Function

INVALID:
　　GetWebStatus = "Invalid URL"

　　Set WinHttp = Nothing

End Function

お礼

＞kenpon24さん

ご回答有難うございます。
一番早く解決できたのでBAにさせていただきます。

まだ、レベルが低すぎてソースコードの細かい部分が
理解できていませんが、書いていただいたコードを基に
学習していきます。

有難うございました！

回答No.2

Wendy02

こんにちは

私はやったことがないですが、そういえば、Webサイトのあるなしを、Status で取得方法があるのだなって、言われて思い出しました。しかし、私が最初に考えたものは、#1さんとほぼイメージとしては同じなのですが、少し工夫をしてみました。

'-------------------------------------------

'Option Explicit
Dim objHTTP As Object 'モジュールの上部に置く
Sub CheckURL()
　　Dim ret As Variant
　　Dim c As Range
　　On Error GoTo ErrHandler
　　If objHTTP Is Nothing Then
　　　　Set objHTTP = CreateObject("WinHttp.WinHttpRequest.5.1")
　　End If

　　For Each c In Range("A1", Range("A2000").End(xlUp))
　　　　If StrConv(c.Value, vbLowerCase) Like "http://*" Then
　　　　　　c.Offset(, 1).Value = GetHttpHeader(c.Value)
　　　　End If
　　Next
ErrHandler:
　　If Err.Number > 0 Then
　　　MsgBox Err.Number & " : " & Err.Description
　　End If
　　Set objHTTP = Nothing
End Sub
Function GetHttpHeader(ByVal strURL As String)
Dim ret As Variant
　　ret = Empty
　　On Error Resume Next
　　objHTTP.Open "GET", strURL, False
　　objHTTP.Send
　　　ret = objHTTP.Status
　　On Error GoTo 0
　　If ret <> 0 Then
　　　GetHttpHeader = ret
　　End If
End Function

お礼

＞fuyuhikoさん

ご回答有難うございます。
まだ、レベルが低くてすんなりと違いを認識できていませんが
問題なく、解決できました！

有難うございます。