【pleasanter/VBA】エクセルからプリザンターへデータを追加、更新する～import～

以前、vbaでプリザンターからデータを取得してエクセルに出力する、というのをシリーズものにしてしつこくやりました。
今回は、vbaでエクセルからプリザンターへデータを追加する、更新する、つまりインポートの動きをやってみたいと思います。

おもに、こちらのサイトで勉強させていただきました。ありがとうございました。
https://qiita.com/m-isik/items/0abfd51a22587bed2e47

１．エクセルVBA to プリザンター エクスポート、インポートの相違点とポイント

HTTPリクエストを送る部分（※）

IXMLHTTPRequestオブジェクト.Open メソッド, URL

ここの違いを押さえればあとはだいたい同じ。
（サーバー名は実際の環境のサーバー名を入れる。サイトID、レコードIDは実際のIDを入れる）

エクスポート
IXMLHTTPRequestオブジェクト.Open “POST”, “http://サーバー名/api/items/サイトID/get“

インポート（新規レコード追加）
IXMLHTTPRequestオブジェクト.Open “POST”, “http://サーバー名/api/items/サイトID/create“

インポート（既存レコード更新）
IXMLHTTPRequestオブジェクト.Open “POST”, “http://サーバー名/api/items/レコードID/update“

おしりがgetかcreateかupdateかの違い。エクスポートと追加はサイトID、既存レコードの更新はレコードIDを指定する。

※本当に送るのはSendの部分だけど送るといったほうがわかりやすいので、とりあえず「送る」で。HTTPリクエストについてはこちらのサイトで勉強させていただきました。わかりやすいです。
https://tonari-it.com/excel-vba-http-request/

公式サイトのapiの記載をみてみると、これを利用しているのかと、おぼろげながらわかってきました。
開発者向け機能：API：テーブル操作：複数レコード取得
開発者向け機能：API：テーブル操作：レコード作成
開発者向け機能：API：テーブル操作：レコード更新

２．VBAの前提条件

①VBAJSONをインポートしておく。
https://github.com/VBA-tools/VBA-JSON

②Microsoft Scripting Runtime を参照設定しておく

３．インポート：レコード作成（追加）

（１）エクセルシート

下図のエクセルシート（シート名import）から値を取得してプリザンターへ送信します。

（２）VBAコード

Sub importToPleasanter()
    Dim ws As Worksheet
    Set ws = Worksheets("import")
    
    '更新情報(実際の環境に合わせてください）
    Const saver As String = "localhost"
    
    Dim apikey As String, siteId As String
    With ws
        apikey = .Range("B2").Value
        siteId = .Range("B3").Value
    End With
    
    'リクエストデータ作成
    Dim jsonRequest As Object
    Set jsonRequest = New Dictionary
    
    jsonRequest.Add "ApiVersion", "1.1"
    jsonRequest.Add "ApiKey", apikey
    jsonRequest.Add "View", New Dictionary
    
    'タイトル
    jsonRequest.Add "Title", ws.Range("A6").Value
    '内容
    jsonRequest.Add "Body", ws.Range("B6").Value
    '状況
    jsonRequest.Add "Status", ws.Range("C6").Value
    
    '分類、数値、日付、説明、チェック等はXXXHashのディクショナリを作成して
    '　そこへディクショナリの入れ子で入れていく
    
    '分類項目
    jsonRequest.Add "ClassHash", New Dictionary
    jsonRequest("ClassHash").Add "ClassA", ws.Range("D6").Value
    jsonRequest("ClassHash").Add "ClassB", ws.Range("E6").Value
    
    '数値項目
    jsonRequest.Add "NumHash", New Dictionary
    jsonRequest("NumHash").Add "NumA", ws.Range("F6").Value
    
    '日付項目※セル値が空白の場合、作成しない
    jsonRequest.Add "DateHash", New Dictionary

    If ws.Range("G6").Value <> "" Then
        '日付項目※なぜか9時間前になるので9時間足す
        jsonRequest("DateHash").Add "DateA", DateAdd("h", 9, ws.Range("G6").Value)
        'もしくは文字列にして渡す

        'jsonRequest("DateHash").Add "DateA", format(ws.Range("G6").Value,"yyyy/mm/ss hh:nn")
    End If

    '説明項目
    jsonRequest.Add "DescriptionHash", New Dictionary
    jsonRequest("DescriptionHash").Add "DescriptionA", ws.Range("H6").Value
    
    'チェック項目
    jsonRequest.Add "CheckHash", New Dictionary
    jsonRequest("CheckHash").Add "CheckA", ws.Range("I6").Value
    
    'イミディエイトウィンドウに作成したリクエストのディクショナリをjson形式で出力してみる
    'Whitespace:=4　は4スペース分のインデント
    Debug.Print JsonConverter.ConvertToJson(jsonRequest, Whitespace:=4)
    
    'プリザンターへ送信
    Dim httpRequest As Object
    Set httpRequest = CreateObject("msxml2.xmlhttp")
    
    'URL文字列作成
    Dim strUrl As String
    strUrl = "http://" & saver & "/api/items/" & siteId & "/create"
    
    httpRequest.Open "POST", strUrl, False
    httpRequest.setRequestHeader "Content-Type", "application/json"
    
    httpRequest.send JsonConverter.ConvertToJson(jsonRequest)
    '成功したら200
    Debug.Print httpRequest.Status

End Sub

（３）プリザンター

プリザンターのサイト132を見てみます。
結果が反映されてない？という場合はブラウザの更新ボタンを押してみてください。

テーブルにレコードが追加されました！ぱちぱち

（４）注意事項

詳しい解説はここではしませんが、注意事項としては

・日付項目はそのままだとなぜか9時間ずれるので、9時間プラスする記述としています。vbajsonの中で変換されるときにマイナス9時間になるみたい？GMT標準時間とやらとの時差が9時間だそうなので、なんとなく納得。
https://time.artjoey.com/jp/japan.htm

もしくはformat関数で文字列にするとよいそうです。
https://asbepartners.com/convjson/#google_vignette

・日付項目はセル値が空欄の場合は、ディクショナリに追加しないこと。マイナス9時間しちゃったり、変なことになったりするのを防止する。

・状況や分類項目など選択肢を設定している項目は表示名ではなく値をインポート値とする

（５）参考：作成したjsonの内容

イミディエイトウインドウに出力したjsonの内容。
日本語は16進数になるとか。。。

{
    "ApiVersion": "1.1",
    "ApiKey": "****",
    "View": {
    },
    "Title": "\u30C6\u30B9\u30C8\uFF11",
    "Body": "\u30C6\u30B9\u30C8\u3067\u3059\u3088",
    "Status": 200,
    "ClassHash": {
        "ClassA": "\u5C0F\u9EA6\u7C89",
        "ClassB": 100
    },
    "NumHash": {
        "NumA": 1234
    },
    "DateHash": {
        "DateA": "2024-02-18T11:54:44.000Z"
    },
    "DescriptionHash": {
        "DescriptionA": "\u8AAC\u660E\u3059\u308B\u3068\u9577\u304F\u306A\u308B"
    },
    "CheckHash": {
        "CheckA": true
    }
}

４．インポート：レコード更新

（１）エクセル

今度はサイトIDは不要でレコードIDが必要になります。

先ほどインポートして作成したレコード139を修正します。

タイトルを「テスト１」→「テスト１の修正」と書き換えます。
内容を「テストですよ」→「修正しました」と書き換えます。
ここからはちょっと実験で、分類A「小麦粉」、説明A「説明すると長くなる」を空欄に書き換えたいと思いました。どちらも空白説に見えますが、分類Aに「=””」と入力してあります。説明Aは空欄でなにも入力していません。

（２）VBAコード

Sub updateToPleasanter()
    Dim ws As Worksheet
    Set ws = Worksheets("import更新")
    
    '更新情報(実際の環境に合わせてください）
    Const saver As String = "localhost"
    
    Dim apikey As String, recordId As String
    With ws
        apikey = .Range("B2").Value
        recordId = .Range("A6").Value
    End With
    
    'リクエストデータ作成
    Dim jsonRequest As Object
    Set jsonRequest = New Dictionary
    
    jsonRequest.Add "ApiVersion", "1.1"
    jsonRequest.Add "ApiKey", apikey
    jsonRequest.Add "View", New Dictionary
    
    'タイトル
    jsonRequest.Add "Title", ws.Range("B6").Value
    '内容
    jsonRequest.Add "Body", ws.Range("C6").Value
    
    '分類、数値、日付、説明、チェック等はXXXHashのディクショナリを作成して
    '　そこへディクショナリの入れ子で入れていく
    
    '分類項目
    jsonRequest.Add "ClassHash", New Dictionary
    jsonRequest("ClassHash").Add "ClassA", ws.Range("D6").Value
    
    '説明項目
    jsonRequest.Add "DescriptionHash", New Dictionary
    jsonRequest("DescriptionHash").Add "DescriptionA", ws.Range("E6").Value
    
    'イミディエイトウィンドウに作成したリクエストのディクショナリをjson形式で出力してみる
    'Whitespace:=4　は4スペース分のインデント
    Debug.Print JsonConverter.ConvertToJson(jsonRequest, Whitespace:=4)
    
    'プリザンターへ送信
    Dim httpRequest As Object
    Set httpRequest = CreateObject("msxml2.xmlhttp")
    
    'URL文字列作成
    Dim strUrl As String
    strUrl = "http://" & saver & "/api/items/" & recordId & "/update"
    
    httpRequest.Open "POST", strUrl, False
    httpRequest.setRequestHeader "Content-Type", "application/json"
    
    httpRequest.send JsonConverter.ConvertToJson(jsonRequest)
    
    '成功したら200
    If httpRequest.Status = 200 Then
        MsgBox "更新しました"
    Else
        MsgBox "更新に失敗しました"
    End If

End Sub

（３）結果

分類Aは空欄に更新されています。セル値が空欄だった説明Aは内容がもとのままで書き換えられていません。

イミディエイトウインドウに出力されたjsonの内容を見てみましょう。
ClassHashのClassAには “” がセットされています。
DiscriptionHashはなにも入っていないですね。Dictionaryの値がEmptyの場合、jsonとして作成されないようです。
逆に、空欄にしておけばプリザンターは更新されないということですね。

{
    "ApiVersion": "1.1",
    "ApiKey": "3921d01096dd1fd8f7cb958e53bc512980e49ac1963e73d538f819e3ab29f08cc56f22a188534f1f2256dbb6a0d7a0d9a98292b0fda73ea82b8c12e3ef45ecbc",
    "View": {
    },
    "Title": "\u30C6\u30B9\u30C81\u306E\u4FEE\u6B63",
    "Body": "\u4FEE\u6B63\u3057\u307E\u3057\u305F",
    "ClassHash": {
        "ClassA": ""
    },
    "DescriptionHash": {
    }
}

５．複数レコードの追加

複数レコードでやってみます。

（１）エクセル

3行分のデータを登録します。

（２）VBAコード

結果的に単一読み込みの時とあまり変わりません。。。
読み込みするデータをいったん配列に入れてループを回していますが、配列に入れずにシートから直接読取でも大丈夫です。
エラー処理などは入れていません。

Sub importToPleasanter2()
    Dim ws As Worksheet
    Set ws = Worksheets("import")
    
    '更新情報(実際の環境に合わせてください）
    Const saver As String = "localhost"
    
    Dim apikey As String, siteId As String
    With ws
        apikey = .Range("B2").Value
        siteId = .Range("B3").Value
    End With
    
    'ワークシートからデータ
    Dim arrData As Variant
    With ws.Range("A5").CurrentRegion
        arrData = .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count).Value
    End With
    
    Dim jsonRequest As Object
    Dim httpRequest As Object
    Dim strUrl As String
    Dim successCnt As Long
    Dim errorCnt As Long
    Dim i As Long
    
    For i = LBound(arrData) To UBound(arrData)
        'リクエストデータ作成
        Set jsonRequest = New Dictionary
        
        jsonRequest.Add "ApiVersion", "1.1"
        jsonRequest.Add "ApiKey", apikey
        jsonRequest.Add "View", New Dictionary
        
        'タイトル
        jsonRequest.Add "Title", arrData(i, 1)
        '内容
        jsonRequest.Add "Body", arrData(i, 2)
        '状況
        jsonRequest.Add "Status", arrData(i, 3)
        
        '分類、数値、日付、説明、チェック等はXXXHashのディクショナリを作成して
        '　そこへディクショナリの入れ子で入れていく
        jsonRequest.Add "ClassHash", New Dictionary
        jsonRequest.Add "NumHash", New Dictionary
        jsonRequest.Add "DateHash", New Dictionary
        jsonRequest.Add "DescriptionHash", New Dictionary
        jsonRequest.Add "CheckHash", New Dictionary
        
        jsonRequest("ClassHash").Add "ClassA", arrData(i, 4)                '分類A
        jsonRequest("ClassHash").Add "ClassB", arrData(i, 5)                '分類B
        jsonRequest("NumHash").Add "NumA", arrData(i, 6)                    '数値A
        '日付項目※セル値が空白の場合、作成しない

　　　　If arrData(i, 7) <> "" then
            jsonRequest("DateHash").Add "DateA", DateAdd("h", 9, arrData(i, 7)) '日付A
        End If
        jsonRequest("DescriptionHash").Add "DescriptionA", arrData(i, 8)    '説明A
        jsonRequest("CheckHash").Add "CheckA", arrData(i, 9)                'チェックA
        
        '*** プリザンターへ送信 ***
        Set httpRequest = CreateObject("msxml2.xmlhttp")
        
        'URL文字列作成
        strUrl = "http://" & saver & "/api/items/" & siteId & "/create"
        
        '初期化
        httpRequest.Open "POST", strUrl, False
        httpRequest.setRequestHeader "Content-Type", "application/json"
        '送信
        httpRequest.send JsonConverter.ConvertToJson(jsonRequest)
       
        '成功したら200
        If httpRequest.Status = 200 Then
            successCnt = successCnt + 1
        Else
            errorCnt = errorCnt + 1
        End If

        Set jsonRequest = Nothing
        Set httpRequest = Nothing
    Next i
 
    MsgBox "処理終了" & vbCrLf & _
        "登録成功" & successCnt & "件" & vbCrLf & _
        "登録失敗" & errorCnt & "件"
End Sub

（３）結果

６．複数レコード更新

（１）エクセル

更新しない項目は空白にしています。チェックAはtrue、falseではなく1,0としてみました。(1がチェックオン(true)、0がチェックオフ(false））になるはず。

レコードID147の説明Aはには開業を入れてあります。はたして反映されるでしょうか。

（２）VBAコード

今度も配列に入れてループしていますが、そのほか特にあんまり変わりはないですね。

Sub updateToPleasanter2()
    Dim ws As Worksheet
    Set ws = Worksheets("import更新")
    
    '更新情報(実際の環境に合わせてください）
    Const saver As String = "localhost"
    
    Dim apikey As String
    Dim recordId As String
    Dim jsonRequest As Object
    Dim httpRequest As Object
    Dim strUrl As String
    Dim successCnt As Long
    Dim errorCnt As Long
    Dim arrData As Variant
    Dim i As Long
    
    'ワークシートからデータ
    With ws
        apikey = .Range("B2").Value
        With .Range("A5").CurrentRegion
            arrData = .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count).Value
        End With
    End With
    
    For i = LBound(arrData) To UBound(arrData)
        'リクエストデータ作成
        Set jsonRequest = New Dictionary
        
        jsonRequest.Add "ApiVersion", "1.1"
        jsonRequest.Add "ApiKey", apikey
        jsonRequest.Add "View", New Dictionary
        
        'レコードID
        recordId = arrData(i, 1)

        '内容
        jsonRequest.Add "Body", arrData(i, 2)
        '状況
        jsonRequest.Add "Status", arrData(i, 3)
        
        '分類、数値、日付、説明、チェック等はXXXHashのディクショナリを作成して
        '　そこへディクショナリの入れ子で入れていく
        jsonRequest.Add "ClassHash", New Dictionary
        jsonRequest.Add "NumHash", New Dictionary
        jsonRequest.Add "DateHash", New Dictionary
        jsonRequest.Add "DescriptionHash", New Dictionary
        jsonRequest.Add "CheckHash", New Dictionary
        
        jsonRequest("ClassHash").Add "ClassA", arrData(i, 4)                '分類A
        jsonRequest("ClassHash").Add "ClassB", arrData(i, 5)                '分類B
        jsonRequest("NumHash").Add "NumA", arrData(i, 6)                    '数値A
        If arrData(i, 7) <> "" Then
            jsonRequest("DateHash").Add "DateA", Format(arrData(i, 7), "yyyy/mm/dd hh:nn") '日付A
        End If
        jsonRequest("DescriptionHash").Add "DescriptionA", arrData(i, 8)    '説明A
        jsonRequest("CheckHash").Add "CheckA", arrData(i, 9)                'チェックA
        
        Debug.Print JsonConverter.ConvertToJson(jsonRequest, Whitespace:=4)
        
        '*** プリザンターへ送信 ***
        Set httpRequest = CreateObject("msxml2.xmlhttp")
        
        'URL文字列作成
        strUrl = "http://" & saver & "/api/items/" & recordId & "/update"
        
        '初期化
        httpRequest.Open "POST", strUrl, False
        httpRequest.setRequestHeader "Content-Type", "application/json"
        '送信
        httpRequest.send JsonConverter.ConvertToJson(jsonRequest)
        
        '成功したら200
        If httpRequest.Status = 200 Then
            successCnt = successCnt + 1
        Else
            errorCnt = errorCnt + 1
        End If
        
        Set jsonRequest = Nothing
        Set httpRequest = Nothing
    Next i
    
    MsgBox "処理終了" & vbCrLf & _
        "登録成功" & successCnt & "件" & vbCrLf & _
        "登録失敗" & errorCnt & "件"
    
End Sub

（３）結果

意図したとおりになっていますね。セル値が空欄の個所は変更されず、セル値が入っているところだけ変更されています。
ID149の説明Aはちゃんと改行されていますね。

７．おわりに

恐れていたより簡単にできた！
複数データを突っ込むときもあまり省略できるところがなかったので、インポート部分を更新値を引数にしたファンクションにしてもよさそうですね。
解説は少なめですが、vbaエクスポートの時にしつこくごちゃごちゃ書いているので、よろしければそちらもご参照ください。
お読みいただきありがとうございました。

8.参考文献、記事

■プリザンター公式サイトより

開発者向け機能：API：テーブル操作：レコード作成

開発者向け機能：API：テーブル操作：レコード更新

開発者向け機能：API：テーブル操作：レコード作成・更新

開発者向け機能：API：テーブル操作：複数レコード取得

FAQ：サンプルコード：ExcelからPleasanterへアクセスしたい

★開発者向け機能：JSONデータレイアウト：View

項目名とデータベース上のカラム名の対応

■参考とさせていただいた記事

PleasanterとExcelを接続してみた－応用編
m-ishikawa1980/ExcelToPleasanter

エクセルVBAでHTTPリクエストをする最も簡単なプログラム

わわわIT用語辞典 > 索引（M） > MSXML

【VBA】Web APIを使ってデータを取得する(OpenWeatherMap)3　HTTPリクエスト

AccessVBAでJSONフォーマットのデータを作成する

内部リンク

プリザンザンターVBAエクスポートシリーズ
【pleasanter/VBA】エクセルからプリザンターのデータを取得する
【pleasanter/VBA】エクセルからプリザンターのデータを取得する②絞り込み条件の指定
【pleasanter/VBA】エクセルからプリザンターのデータを取得する③変数で絞り込み条件を指定する
【pleasanter/VBA】エクスポート④絞り込み条件で〇〇を含むを指定する
【pleasanter/VBA】エクスポート⑤並べ替え
【pleasanter/VBA】エクスポート⑥表示名を出したい
【pleasanter/VBA】エクスポート⑦データがちょん切れる時の対応 Offset
【pleasanter/VBA】エクスポート⑧出力される日付を文字列ではなく日付時刻型で出したい
【pleasanter/VBA】エクスポート⑨汎用ツールを作ってみた
【pleasanter/VBA】エクスポート⑩汎用ツール増強版

プリザンターPowerQuery連携シリーズ
【pleasanter/PowerQuery】プリザンターの情報をパワークエリで取得する①
【pleasanter/PowerQuery】プリザンターの情報をパワークエリで取得する②取得条件の指定方法
【pleasanter/PowerQuery】プリザンターの情報をパワークエリで取得する③上限値以上のレコードを連続で取得する
【pleasanter/PowerQuery】プリザンターの情報をパワークエリで取得する④ユーザーテーブルとマージ