https://www.sejuku.net/blog/28904
https://excel-ubara.com/excelvba1/EXCELVBA408.html
-- 1. 開発タブの挿入でボタンを作成
※ ActiveXコントロールのものを使用する
-- 2. デザインモードONで作成したボタンをダブルクリックするとエディタが開くので下記コードを記載。デザインモードOFFで実行
※ 下記設定必要
「Microsoft Scripting Runtime」の参照設定
「Microsoft XML, v6.0」を参照設定
VBA-JSONのインポート
Option Explicit
Dim httpReq As New XMLHTTP60 '「Microsoft XML, v6.0」を参照設定
Dim params As New Dictionary '「Microsoft Scripting Runtime」を参照設定
Private Sub CommandButton1_Click()
' 画面を更新しない
Application.ScreenUpdating = False
' 確認メッセージを表示しない
Application.DisplayAlerts = False
'step 1
If do_Get() = False Then
MsgBox "GETが失敗しました"
GoTo Errend:
End If
'step 2
If do_Post() = False Then
MsgBox "Postが失敗しました"
GoTo Errend:
End If
MsgBox ("処理完了")
Errend:
' 確認メッセージを表示する
Application.DisplayAlerts = True
' 画面を更新する
Application.ScreenUpdating = True
'オブジェクトクリア
Set httpReq = Nothing
Set params = Nothing
End Sub
'''' GET関数
Function do_Get() As Boolean
do_Get = False
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
Do While httpReq.readyState < 4
DoEvents
Loop
If httpReq.Status = 200 Then
Debug.Print "GETが正常に終了しました"
do_Get = True
Else
Debug.Print "GETが失敗しました"
End If
End Function
'''' POST関数
Function do_Post() As Boolean
do_Post = False
params.Add "name", "project123"
params.Add "description", "description of project123"
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
Debug.Print "POSTが正常に終了しました"
do_Post = True
Else
Debug.Print "POSTが失敗しました"
End If
End Function
