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

7742 ワード
VBA Excel Excel テキストリンク

はじめに

以前に【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
'--------------------------------------------------------------------------------
' 引数のURLに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

参考URL

【C++11】ランダム値取得——random
QQ粘性効果