https://vba-labo.rs-techdev.com/archives/1401
https://spirits.appirits.com/doruby/8717/
https://papasensei365.com/excel-httprequest-proxy/
https://vba-create.jp/vba-dictionary-remove/
-- 1. 開発タブの挿入でボタンを作成
※ ActiveXコントロールのものを使用する
-- 2. デザインモードONで作成したボタンをダブルクリックするとエディタが開くので下記コードを記載。デザインモードOFFで実行
※ 下記設定必要
「Microsoft Scripting Runtime」の参照設定
「Microsoft XML, v6.0」を参照設定
VBA-JSONのインポート
Private Sub CommandButton1_Click()
Dim httpReq As New XMLHTTP60 '「Microsoft XML, v6.0」を参照設定
Dim params As New Dictionary '「Microsoft Scripting Runtime」を参照設定
Dim list As New Collection
Dim jsonObj As Object
Dim jsonObj2 As Object
Dim jsonTxt As String
' 画面を更新しない
Application.ScreenUpdating = False
' 確認メッセージを表示しない
Application.DisplayAlerts = False
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' GETサンプル
With httpReq
.Open "GET", "http://localhost:9090/webadmin/denodo-scheduler-admin/public/api/projects?uri=//localhost:8000"
.setRequestHeader "Authorization", "Basic YWRtaW46YWRtaW4="
.setRequestHeader "Content-Type", "application/json"
.send
End With
'0 UNSENT クライアントは作成済み。 open() はまだ呼ばれていない。
'1 OPENED open() が呼び出し済み。
'2 HEADERS_RECEIVED send() が呼び出し済みで、ヘッダーとステータスが利用可能。
'3 LOADING ダウンロード中。responseText には部分データが入っている。
'4 DONE 操作が完了した。
Do While httpReq.readyState < 4
DoEvents
Loop
If httpReq.Status = 200 Then
MsgBox "GETが正常に終了しました"
Else
MsgBox "GETが失敗しました"
End If
Debug.Print "GETレスポンス"
Debug.Print httpReq.responseText
' JSONパース
Set jsonObj = JsonConverter.ParseJson(httpReq.responseText)
For Each j In jsonObj
Debug.Print j("id")
Debug.Print j("projectDetails")("name")
Next
' JSON整形テキスト
Debug.Print "JSON整形テキスト"
jsonTxt = JsonConverter.ConvertToJson(jsonObj, " ", 4)
Debug.Print jsonTxt
Debug.Print ""
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' POSTサンプル
params.Add "name", "project123"
params.Add "description", "description of project123"
' デフォルト出力
Debug.Print "デフォルト"
jsonTxt = JsonConverter.ConvertToJson(params)
Debug.Print jsonTxt
' インデント付き(インデント=4）
Debug.Print "インデント付き(インデント=4）"
jsonTxt = JsonConverter.ConvertToJson(params, " ", 4)
Debug.Print jsonTxt
With httpReq
.Open "POST", "http://localhost:9090/webadmin/denodo-scheduler-admin/public/api/projects?uri=//localhost:8000"
.setRequestHeader "Authorization", "Basic YWRtaW46YWRtaW4="
.setRequestHeader "Content-Type", "application/json"
.send JsonConverter.ConvertToJson(params)
End With
Do While httpReq.readyState < 4
DoEvents
Loop
If httpReq.Status = 201 Then
MsgBox "POSTが正常に終了しました"
Else
MsgBox "POSTが失敗しました"
End If
Debug.Print "POSTレスポンス"
Debug.Print httpReq.responseText
' JSONパース
Set jsonObj = JsonConverter.ParseJson(httpReq.responseText)
Debug.Print "id = " & jsonObj("id")
' JSON整形テキスト
Debug.Print "JSON整形テキスト"
jsonTxt = JsonConverter.ConvertToJson(jsonObj, " ", 4)
Debug.Print jsonTxt
Debug.Print ""
' JSON修正テキスト
Set jsonObj2 = jsonObj
'キー削除
jsonObj2.Remove "id"
'キー追加
jsonObj2.Add "key1", "value1"
'リスト追加
list.Add "item1"
list.Add "item2"
jsonObj2.Add "key2", list
Debug.Print "JSON修正テキスト"
jsonTxt = JsonConverter.ConvertToJson(jsonObj2, " ", 4)
Debug.Print jsonTxt
Debug.Print ""
MsgBox ("処理完了")
' 確認メッセージを表示する
Application.DisplayAlerts = True
' 画面を更新する
Application.ScreenUpdating = True
End Sub
