15
2

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?

More than 1 year has passed since last update.

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

Last updated at Posted at 2021-12-06

はじめに

以前投稿した[こちら]の記事の応用編として、汎用的なエクセルツールとして、Pleasanterのテーブルを取得・登録できるものを作ってみました。

前提

  • VBAでJsonを扱うため、[VBA-JSON]を利用しています。
  • PleasatnerのAPIの扱いについては[マニュアル]を参考にしてください。

Excel画面

作成した画面は以下のとおり。(UIデザインセンスの無さはご勘弁)

テーブル取得用シート

image.png

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

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

テーブル登録用シート

image.png

こちらも、各種条件をエクセルから指定させるようにします。ただ、今回は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の値を設定してください。
    image.png

  • (繰り返しになりますが)[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にアクセスできるようになりました。
次回、このツールを活用し、より実践的な使い方を考えてみます。

15
2
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
15
2

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?