[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

実行後のイメージは以下のような感じ。

参考:http://okwave.jp/qa/q5474619.html

コメントを残す

メールアドレスが公開されることはありません。 * が付いている欄は必須項目です