62 lines
1.7 KiB
QBasic
62 lines
1.7 KiB
QBasic
|
|
Attribute VB_Name = "Module1"
|
|
Option Explicit
|
|
|
|
|
|
'Web APIへJSONパラメータを付与してデータを取得する関数
|
|
Public Sub FetchDataFromWebAPI(recordId As String)
|
|
'APIキーを設定
|
|
Dim apiKey As String
|
|
apiKey = "6504c8a807677a3a576e10327f3c19876c55736ee45d4a845796b9e7f5e087bfd4bd0d8184863da8cf1733ca635111432ab334aea59102b06a96ee6d2c05190d"
|
|
|
|
Dim http As Object
|
|
Dim url As String
|
|
Dim response As String
|
|
Dim jsonBody As String
|
|
Dim postData As Object
|
|
Dim jsonRes As Object
|
|
|
|
'VBA-JSONのDictionaryを利用
|
|
Set postData = CreateObject("Scripting.Dictionary")
|
|
postData("ApiVersion") = "1.1"
|
|
postData("ApiKey") = apiKey
|
|
|
|
'JsonConverter.ConvertToJsonでJSON文字列に変換
|
|
jsonBody = JsonConverter.ConvertToJson(postData)
|
|
|
|
'url = "https://jsonplaceholder.typicode.com/todos" " POST用のエンドポイント例
|
|
url = "https://nextoffice.Next-hd.co.jp/pleasanter/api/items/" & recordId & "/Get"
|
|
|
|
Debug.Print "URL: " & url
|
|
Debug.Print "JSON Body: " & jsonBody
|
|
|
|
Set http = CreateObject("MSXML2.XMLHTTP")
|
|
http.Open "POST", url, False
|
|
http.setRequestHeader "Content-Type", "application/json"
|
|
http.send jsonBody
|
|
|
|
Debug.Print http.Status & " " & http.statusText
|
|
|
|
|
|
If http.Status = 201 Or http.Status = 200 Then
|
|
response = http.responseText
|
|
'レスポンスをJSONとしてパース
|
|
Set jsonRes = JsonConverter.ParseJson(response)
|
|
Debug.Print "取得データ: " & jsonRes("Response")("Data")(1)("Title")
|
|
|
|
Else
|
|
MsgBox "エラー: " & http.Status & " - " & http.statusText
|
|
|
|
End If
|
|
|
|
Set http = Nothing
|
|
End Sub
|
|
|
|
'FetchDataFromWebAPIを呼び出す例
|
|
Public Sub TestFetchData()
|
|
Dim recordId As String
|
|
recordId = "119261" '適切なレコードIDに置き換えてください
|
|
FetchDataFromWebAPI recordId
|
|
|
|
End Sub
|