はじめに
以前投稿した[こちら]の記事の応用編として、汎用的なエクセルツールとして、Pleasanterのテーブルを取得・登録できるものを作ってみました。
前提
- VBAでJsonを扱うため、[VBA-JSON]を利用しています。
- PleasatnerのAPIの扱いについては[マニュアル]を参考にしてください。
Excel画面
作成した画面は以下のとおり。(UIデザインセンスの無さはご勘弁)
テーブル取得用シート
取得対象のPleasanter、サイト、抽出条件、取得項目をエクセルから指定させることで、フレキシブルにいろいろな情報をPleasatnerから取得できるようにしました。
- B2セル:取得対象のPleasanterのサイトIDを設定
- B3セル:取得対象のPleasanterのUrlを設定
- 6行目:抽出条件とするColumnFilterHashに設定する項目名を必要な分だけ設定
- 7行目:抽出条件値を項目カラムに合わせて設定
- 22行目:ソートしたい場合、a(昇順)、d(降順)を設定
- 23行目:Pleasanterから取得したい項目を設定
- 24行目以降:Pleasanterから取得した項目が展開される
- 取得ボタン押下でPleasanterから項目を取得、クリアボタン押下で取得結果をクリア
テーブル登録用シート
こちらも、各種条件をエクセルから指定させるようにします。ただ、今回は1レコードずつの登録のみに対応。
- B2セル:登録対象のPleasanterのサイトIDを設定
- B3セル:登録対象のPleasanterのレコードIDを設定。未入力の場合新規作成する
- B6セル:登録結果を表示
- B7セル:登録後、登録したレコードのPleasanterへのリンクを設定
- 10行目:登録したいPleasanterの項目を必要な分だけ設定
- 11行目:登録する値を設定
- 登録ボタン押下でPleasanterに登録
サンプルコード
[こちら]からDLして、VBAにインポートしてみてください。
(ApiHttpControl.bas、ApiKeyControl.bas、ExcelControl.bas、MainControl.bas)
注意
-
以下参照設定が必要です。
- Microsoft Scripting Runtime
- Windows Script Host Object Model
-
PleasanterにアクセスできるApiKeyを取得し、利用端末のユーザ環境変数に、変数名”ApiKey”にApiKeyの値を設定してください。
-
(繰り返しになりますが)[VBA-JSON]もインポートしてください。
-
適当なシートに、前述の要素を用意してください。カラム位置を変更したい場合は、VBAも調整してください。
-
適当なシートから、ボタンやショートカットなどで、以下の関数を実行するように割り当ててください。
- テーブル取得シート → テーブル取得メイン・アクティブシートクリア
- テーブル登録シート → テーブル登録メイン
これできっとうまくいくはず。
簡単なソース解説
テーブル取得メイン処理
※主要な部分だけ抜粋
'実行前にシートクリア処理とかあるけど割愛
'アクティブシート名を取得
' → シートを増やしても、アクティブにしてから関数を実行すれば取得可
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
'実行後にソート処理とかあるけど割愛
テーブル登録メイン処理
※主要な部分だけ抜粋
'アクティブシート名を取得
'→ シートを増やしても、アクティブにしてから関数を実行すれば取得可
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にアクセスできるようになりました。
次回、このツールを活用し、より実践的な使い方を考えてみます。