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

質問

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

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

宜しくお願いします。

回答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さん

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

有難うございます。