【Excel】【VBA】HTTPリクエストを送信してステータスコードを取得する

複数のURLに対してGETリクエストを送信するというツールを作ったのでメモ。今回はリクエストに対し、レスポンスのステータスコードを取得することにした。

A列にURLをセットし実行すると、B列にステータスコードがセットされる、というマクロ。

Sub Sample()

    Dim i As Long
    Dim bottom As Long
  
    '最下行を取得
    bottom = Range("A65536").End(xlUp).Row
  
    '最下行まで繰り返し
    For i = 1 To bottom
    
        'A列のURLに対し、
        'ステータスコードをB列にセット
        Range("B" & i) = GetWebStatus(Range("A" & i))
  
    Next i
  
End Sub

Function GetWebStatus(URL As String) As String

    Dim WinHttp As Object

    '"WinHttp.WinHttpRequest.5.1"ではうまくいかなかったため
    '"MSXML2.XMLHTTP"を利用
    'Set WinHttp = CreateObject("WinHttp.WinHttpRequest.5.1")
    Set WinHttp = CreateObject("MSXML2.XMLHTTP")

On Error GoTo INVALID

    
    WinHttp.Open "GET", URL, False
    WinHttp.send  'GETリクエストを送信

    GetWebStatus = WinHttp.Status  'ステータスコードをセット
  
    Set WinHttp = Nothing
  
    Exit Function
  
INVALID:
    GetWebStatus = "Invalid URL"
  
    Set WinHttp = Nothing
  
End Function