VBAでREST通信をする際のコードを各種サイトのコードを自分がわかりやすいようにまとめた。

Option Explicit

'--------------------------------------------------------------------------------
' HTTP通信用クラス。
' 依存: 
' GitHubの下記Dictionaryクラスをbasファイルとしてプロジェクト内に入れておく
' https://github.com/timhall/VBA-Dictionary
' 使用例:
'    パラメータの設定は、以下のようにしてsendメソッドの引数に入れる
'    Dim apiHeaders As Dictionary
'    apiHeaders.Add "Authorization", "Basic " & base64Credentials
'    apiHeaders.Add "Accept", "application/json"
'    apiHeaders.Add "Content-Type", "application/json"
'  動作確認:
'    以下のサイトがありがたい
'    http://httpbin.org
'--------------------------------------------------------------------------------

' 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に指定メソッドで送信する。
'
' method : GET POST PATCH
' url：URL文字列
' urlParams：URLパラメーター
' headers: リクエストヘッダ
' return：レスポンスの文字列をJson解析したオブジェクト
'--------------------------------------------------------------------------------
Public Function send(method As String, url As String, urlParams As String, Optional ByVal headers As Dictionary = Null) As Object
    httpObj.Open method, url, False


    ' リクエストヘッダー設定
    Dim i As Long
    For i = 0 To headers.Count - 1
        httpObj.setRequestHeader headers.Keys(i), headers.Items(i)
    Next i
    
    httpObj.send (urlParams)

    ' readyState=4: 読み込み完了
    Do While httpObj.readyState < 4
        DoEvents
    Loop

    Dim statusCode As Integer
    statusCode = httpObj.Status

    If (statusCode = 200) Then
        Debug.Print "200:OK"
        'PostContents = httpObj.responseText ' レスポンスの文字コードがShift_JIS(MS932)の時はこちらを使う。
        'PostContents = StrConv(httpObj.responsebody, vbUnicode)
        
        ' レスポンスの文字列（objHTTP.responseText）をJsonに変換して返却
        Debug.Print "---------------"
        Debug.Print httpObj.responseText
        
        Dim responsJson As Object
        Set responsJson = JsonConverter.ParseJson(httpObj.responseText)
        responsJson("HTTP StatusCode") = 200
        Set send = responsJson
    Else
        Set send = JsonConverter.ParseJson("{""HTTP StatusCode"" : """ & statusCode & """, ""HTTP StatusText"" : """ & httpObj.statusText & """}")
    End If
End Function

UUID †

requestIDを用意する場合に必要になるかもしれない。以下にコードがある https://www.330k.info/essay/create_uuid_vba/

トップ   編集 凍結 差分 バックアップ 添付 複製 名前変更 リロード   新規 一覧 単語検索 最終更新   ヘルプ   最終更新のRSS
Last-modified: 2024-04-16 (火) 10:52:56 (146d)