【ExcelVBA】HTTP/HTTPS通信でPOSTメソッドを使う

はじめに

以前に【ExcelVBA】HTTP/HTTPS通信でWebページを取得するを投稿した後、すぐにPOSTメソッドを使う処理を作ろうと思っていたのですが、何だかんだで先送りになって1年近く経ってしまいました。

そこで休暇を利用してPOSTメソッドの処理をサッと作ってみました。

作成したクラス

• POSTメソッドに関する記事はそれほど多くありませんでしたが、こちらの記事が非常に参考になりました。

HttpClient.bas

Option Explicit

'--------------------------------------------------------------------------------
' HTTP通信用クラス。
'--------------------------------------------------------------------------------

' HTTP通信用オブジェクト
Private httpObj As Object

'--------------------------------------------------------------------------------
' コンストラクタ
'--------------------------------------------------------------------------------
Public Sub Class_Initialize()
    Set httpObj = CreateObject("MSXML2.ServerXMLHTTP")    ' TLS1.2に対応
End Sub
​
'--------------------------------------------------------------------------------
' デストラクタ
'--------------------------------------------------------------------------------
Public Sub Class_Terminate()
    Set httpObj = Nothing
End Sub
​
'--------------------------------------------------------------------------------
' 引数のURLにPostメソッドで送信する。
'
' url：URL文字列。
' urlParams：URLパラメーター。
' return：レスポンスの文字列。
'--------------------------------------------------------------------------------
Public Function PostContents(url As String, urlParams As String) As String
    httpObj.Open "POST", url, False
    httpObj.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
    httpObj.send (urlParams)
    
    ' readyState=4で読み込みが完了
    Do While httpObj.readyState < 4
        DoEvents
    Loop

    Dim statusCode As Integer
    statusCode = httpObj.Status

    ' HTTPのステータスコードが200(OK)以外であれば、ステータスコードなどを返す。
    If (statusCode = 200) Then
        'PostContents = httpObj.responseText ' レスポンスの文字コードがShift_JIS(MS932)の時はこちらを使う。
        PostContents = StrConv(httpObj.responsebody, vbUnicode)
    Else
        PostContents = "HTTP StatusCode:" & statusCode & ", HTTP StatusText:" & httpObj.statusText
    End If
End Function

テストコード

• httpbin.orgというサイトではPOSTメソッドが使えるため、このサイトを借りてテストコードを作成しました。
• 送信しているパラメーターは適当な値です。

HttpClientTest.bas

Option Explicit

'--------------------------------------------------------------------------------
' Postメソッドのテストを実行する。
'--------------------------------------------------------------------------------
Public Sub Test_PostContents()
    Dim httpObj As HttpClient
    Set httpObj = New HttpClient

    Dim response As String
    ' レスポンスはUTF-8。
    response = httpObj.PostContents("http://httpbin.org/post", "param1=abc&param2=123")
    Debug.Print response
End Sub

• 実行結果は以下の通りですが、接続元IP（origin）だけ伏せ字にしています。

実行結果

{
  "args": {}, 
  "data": "", 
  "files": {}, 
  "form": {
    "param1": "abc", 
    "param2": "123"
  }, 
  "headers": {
    "Accept": "*/*", 
    "Accept-Language": "ja", 
    "Content-Length": "21", 
    "Content-Type": "application/x-www-form-urlencoded", 
    "Host": "httpbin.org", 
    "User-Agent": "Mozilla/4.0 (compatible; Win32; WinHttp.WinHttpRequest.5)", 
    "X-Amzn-Trace-Id": "Root=1-68499ee4-50ace93c6633643b471f1cd8"
  }, 
  "json": null, 
  "origin": "xxx.xxx.xxx.xxx", 
  "url": "http://httpbin.org/post"
}

参考URL

• ExcelVBA、ExcelマクロからHTTPでPOSTする
• 【ExcelVBA】HTTP/HTTPS通信でWebページを取得する
• httpbin.org