PleasanterとExcelを接続してみた－応用編

# はじめに
以前投稿した[[こちら]](https://qiita.com/m-isik/items/7afb0907a1dc60225453)の記事の応用編として、汎用的なエクセルツールとして、Pleasanterのテーブルを取得・登録できるものを作ってみました。

# 前提
*  VBAでJsonを扱うため、[[VBA-JSON]](https://github.com/VBA-tools/VBA-JSON)を利用しています。
*  PleasatnerのAPIの扱いについては[[マニュアル]](https://pleasanter.org/manual?category=2100)を参考にしてください。

# Excel画面
作成した画面は以下のとおり。（UIデザインセンスの無さはご勘弁）  
####  テーブル取得用シート
![image.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/922382/ac8ee8b4-1466-f27b-1b7c-ba44806b4aa9.png)

取得対象のPleasanter、サイト、抽出条件、取得項目をエクセルから指定させることで、フレキシブルにいろいろな情報をPleasatnerから取得できるようにしました。

* B2セル：取得対象のPleasanterのサイトIDを設定
* B3セル：取得対象のPleasanterのUrlを設定
* 6行目：抽出条件とするColumnFilterHashに設定する項目名を必要な分だけ設定
* 7行目：抽出条件値を項目カラムに合わせて設定
* 22行目：ソートしたい場合、a（昇順）、d（降順）を設定
* 23行目：Pleasanterから取得したい項目を設定
* 24行目以降：Pleasanterから取得した項目が展開される
* 取得ボタン押下でPleasanterから項目を取得、クリアボタン押下で取得結果をクリア

####  テーブル登録用シート
![image.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/922382/69e303f2-1b02-965f-c2a1-ce8a561ba8d5.png)

こちらも、各種条件をエクセルから指定させるようにします。ただ、今回は１レコードずつの登録のみに対応。

* B2セル：登録対象のPleasanterのサイトIDを設定
* B3セル：登録対象のPleasanterのレコードIDを設定。未入力の場合新規作成する
* B6セル：登録結果を表示
* B7セル：登録後、登録したレコードのPleasanterへのリンクを設定
* 10行目：登録したいPleasanterの項目を必要な分だけ設定
* 11行目：登録する値を設定
* 登録ボタン押下でPleasanterに登録

# サンプルコード

[[こちら]](https://github.com/m-ishikawa1980/ExcelToPleasanter/tree/main)からDLして、VBAにインポートしてみてください。
（ApiHttpControl.bas、ApiKeyControl.bas、ExcelControl.bas、MainControl.bas）

####  注意
- 以下参照設定が必要です。  
    - Microsoft Scripting Runtime
    - Windows Script Host Object Model
- PleasanterにアクセスできるApiKeyを取得し、利用端末のユーザ環境変数に、変数名”ApiKey”にApiKeyの値を設定してください。
![image.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/922382/8ca15fd6-ac07-ee2e-0faa-029ed8f39b19.png)


- (繰り返しになりますが)[[VBA-JSON]](https://github.com/VBA-tools/VBA-JSON)もインポートしてください。
-  適当なシートに、前述の要素を用意してください。カラム位置を変更したい場合は、VBAも調整してください。
-  適当なシートから、ボタンやショートカットなどで、以下の関数を実行するように割り当ててください。
    -  テーブル取得シート → テーブル取得メイン・アクティブシートクリア
    -  テーブル登録シート → テーブル登録メイン

これできっとうまくいくはず。

#  簡単なソース解説

####  テーブル取得メイン処理
※主要な部分だけ抜粋

```vb

'実行前にシートクリア処理とかあるけど割愛

'アクティブシート名を取得
' → シートを増やしても、アクティブにしてから関数を実行すれば取得可
sheetName = ActiveSheet.Name

'リクエストのためのjson用Dictionaryを用意する
Set GetMultiRecordJson = New Dictionary
Set GetMultiRecordJson = SetApiKey(GetEnvironmentApiKey, GetMultiRecordJson)

'入力エリアに設定された条件値の数をEnd(xlToRight).Columnで取得する
'テーブル取得入力エリア
'　→　Enumでカラム情報を定義、エクセルレイアウトを変えたい場合は変更要
maxCol = Worksheets(sheetName).Cells(テーブル取得入力エリア.開始行, テーブル取得入力エリア.開始列).End(xlToRight).Column

'設定された条件値の分ループして、リクエストするjson用Dictionaryを生成する
'json用Dictionary生成は関数化
'　→　SetColumnFilterHash、SetColumnFilterHashItemなど、処理はApiHttpControl.bas参照
For j = 1 To maxCol

    If Worksheets(sheetName).Cells(テーブル取得入力エリア.開始行 + 1, j).Value <> "" Then 
        If filterFirst = True Then
            'フィルターがあれば初回だけ作る
            Set GetMultiRecordJson = SetView(GetMultiRecordJson)
            'フィルターがあれば初回だけ作る
            Set GetMultiRecordJson = SetColumnFilterHash(GetMultiRecordJson)
            filterFirst = False
        End If
        '関数にキーと値を渡してjson用Dictionaryに設定する
        Set GetMultiRecordJson = SetColumnFilterHashItem(Worksheets(sheetName).Cells(テーブル取得入力エリア.開始行, j).Value, _
                                                    Worksheets(sheetName).Cells(テーブル取得入力エリア.開始行 + 1, j).Value, _
                                                    GetMultiRecordJson)
    End If
Next j

'リクエスト用のURLを設定する
strUrl = Worksheets(sheetName).Cells(3, 2).Value & "/api/items/" & Worksheets(sheetName).Cells(2, 2).Value & "/get"

'HTTPリクエスト発行　→　ApiHttpControl.bas参照
'リクエスト発行時にVBA-JSONでDictionaryをJson形式にコンバート
Set objHTTP = HTTPリクエスト発行(strUrl, GetMultiRecordJson)

'レスポンスjsonをパース（VBA-JSON）
Set Parse = JsonConverter.ParseJson(objHTTP.responseText)

'取得件数をチェック、0件なら処理終了
If Parse("Response")("Data").count <= 0 Then
    Exit Sub
End If

'出力エリアに設定された出力カラムの数をEnd(xlToRight).Columnで取得する
'テーブル取得出力エリア
'　→　Enumでカラム情報を定義、エクセルレイアウトを変えたい場合は変更要
maxCol = Worksheets(sheetName).Cells(テーブル取得出力エリア.開始行, テーブル取得出力エリア.開始列).End(xlToRight).Column

ReDim Pj(Parse("Response")("Data").count - 1, maxCol)

i = 0
sortKey = 0

'取得データ件数分ループ
For Each DesStr In Parse("Response")("Data")
     
    '出力エリアに設定した出力カラム数分ループ
    For j = 0 To maxCol - 1
        
        Select Case True
        
        '項目種類ごとに編集
        Case InStr(Worksheets(sheetName).Cells(テーブル取得出力エリア.開始行, j + 1).Value, "Class")
            Pj(i, j) = DesStr("ClassHash")(Worksheets(sheetName).Cells(テーブル取得出力エリア.開始行, j + 1).Value)
        
        Case InStr(Worksheets(sheetName).Cells(テーブル取得出力エリア.開始行, j + 1).Value, "Num")
            Pj(i, j) = DesStr("NumHash")(Worksheets(sheetName).Cells(テーブル取得出力エリア.開始行, j + 1).Value)
        
        Case InStr(Worksheets(sheetName).Cells(テーブル取得出力エリア.開始行, j + 1).Value, "Date")
            Pj(i, j) = DesStr("DateHash")(Worksheets(sheetName).Cells(テーブル取得出力エリア.開始行, j + 1).Value)
        
        Case InStr(Worksheets(sheetName).Cells(テーブル取得出力エリア.開始行, j + 1).Value, "Check")
            Pj(i, j) = DesStr("CheckHash")(Worksheets(sheetName).Cells(テーブル取得出力エリア.開始行, j + 1).Value)
        
        Case InStr(Worksheets(sheetName).Cells(テーブル取得出力エリア.開始行, j + 1).Value, "Description")
            Pj(i, j) = DesStr("DescriptionHash")(Worksheets(sheetName).Cells(テーブル取得出力エリア.開始行, j + 1).Value)

        Case Else
            Pj(i, j) = DesStr(Worksheets(sheetName).Cells(テーブル取得出力エリア.開始行, j + 1).Value)
            
        End Select
        'ソートのための処理とかあるけどここでは割愛
    Next j        
     i = i + 1
Next

'エクセルに取得情報を展開
Worksheets(sheetName).Range(Worksheets(sheetName).Cells(テーブル取得出力エリア.開始行 + 1, テーブル取得出力エリア.開始列), _
                    Worksheets(sheetName).Cells(Parse("Response")("Data").count + テーブル取得出力エリア.開始行, maxCol)) = Pj

'実行後にソート処理とかあるけど割愛

```
####  テーブル登録メイン処理
※主要な部分だけ抜粋

```vb

'アクティブシート名を取得 
'→ シートを増やしても、アクティブにしてから関数を実行すれば取得可
sheetName = ActiveSheet.Name

'リクエストのためのjson用Dictionaryを用意する
Set CreateRecordJson = New Dictionary
Set CreateRecordJson = SetApiKey(GetEnvironmentApiKey, CreateRecordJson)

'入力エリアに設定された条件値の数をEnd(xlToRight).Columnで取得する
'テーブル登録入力エリア
'　→　Enumでカラム情報を定義、エクセルレイアウトを変えたい場合は変更要
maxCol = Worksheets(sheetName).Cells(テーブル登録入力エリア.開始行, テーブル登録入力エリア.開始列).End(xlToRight).Column

'設定された条件値の分ループして、リクエストするjson用Dictionaryを生成する
'json用Dictionary生成は関数化
'　→　SetClassHash、SetClassHashItemなど、処理はApiHttpControl.bas参照
For j = 1 To maxCol

        Select Case True
        
        '項目種類ごとに編集する（Check項目には対応できていません！！）
        Case InStr(Worksheets(sheetName).Cells(テーブル登録入力エリア.開始行, j).Value, "Class")
            If classHashFirst = True Then
                '初回だけ作る
                Set CreateRecordJson = SetClassHash(CreateRecordJson)
                classHashFirst = False
            End If
            
            Set CreateRecordJson = SetClassHashItem(Worksheets(sheetName).Cells(テーブル登録入力エリア.開始行, j), _
                                                    Worksheets(sheetName).Cells(テーブル登録入力エリア.開始行 + 1, j), _
                                                    CreateRecordJson)
        Case InStr(Worksheets(sheetName).Cells(テーブル登録入力エリア.開始行, j + 1).Value, "Num")
            If numHashFirst = True Then
                '初回だけ作る
                Set CreateRecordJson = SetNumHash(CreateRecordJson)
                numHashFirst = False
            End If
            
            Set CreateRecordJson = SetNumHashItem(Worksheets(sheetName).Cells(テーブル登録入力エリア.開始行, j), _
                                                    Worksheets(sheetName).Cells(テーブル登録入力エリア.開始行 + 1, j), _
                                                    CreateRecordJson)
        Case InStr(Worksheets(sheetName).Cells(テーブル登録入力エリア.開始行, j + 1).Value, "Date")
            If dateHashFirst = True Then
                '初回だけ作る
                Set CreateRecordJson = SetDateHash(CreateRecordJson)
                dateHashFirst = False
            End If
            
            Set CreateRecordJson = SetDateHashItem(Worksheets(sheetName).Cells(テーブル登録入力エリア.開始行, j), _
                                                    Worksheets(sheetName).Cells(テーブル登録入力エリア.開始行 + 1, j), _
                                                    CreateRecordJson)
        Case Else
            Set CreateRecordJson = SetItem(Worksheets(sheetName).Cells(テーブル登録入力エリア.開始行, j), _
                                                    Worksheets(sheetName).Cells(テーブル登録入力エリア.開始行 + 1, j), _
                                                    CreateRecordJson)
        End Select
Next j

'URLを生成
If Worksheets(sheetName).Cells(3, 2).Value & Worksheets(sheetName).Cells(3, 2).Value = "" Then
'登録IDが無ければ新規
    strUrl = Worksheets(sheetName).Cells(4, 2).Value & "/api/items/" & Worksheets(sheetName).Cells(2, 2).Value & "/create"
Else
'存在したら更新
    strUrl = Worksheets(sheetName).Cells(4, 2).Value & "/api/items/" & Worksheets(sheetName).Cells(3, 2).Value & "/update"
End If

'HTTPリクエスト発行　→　ApiHttpControl.bas参照
'リクエスト発行時にVBA-JSONでDictionaryをJson形式にコンバート
Set objHTTP = HTTPリクエスト発行(strUrl, CreateRecordJson)
    
'レスポンスjsonをパース（VBA-JSON）
Set Parse = JsonConverter.ParseJson(objHTTP.responseText)

'エクセルに結果を転記
Worksheets(sheetName).Cells(6, 2).Value = objHTTP.statusText & "(Status:" & objHTTP.Status & ")"
Worksheets(sheetName).Cells(7, 2).Value = "=HYPERLINK(""" & Worksheets(sheetName).Cells(4, 2).Value & _
    "/items/" & Parse("Id") & "/"",""" & Parse("Id") & """)"

```

#  まとめ
使い慣れたExcelシートから汎用的にPleasanterにアクセスできるようになりました。
次回、このツールを活用し、より実践的な使い方を考えてみます。