VBAでREST通信 の変更点

• 追加された行はこの色です。
• 削除された行はこの色です。
• VBAでREST通信 へ行く。

<!-- markdown -->

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/