【pleasanter/VBA】エクスポート②絞り込み条件の指定

前回はエクセルVBAを利用してプリザンターのサイトからそのまま情報をエクスポートしましたが、今回は絞り込み条件を付けてエクスポートする、をやってみたいと思います。

※おことわり
2023年7月時点の情報です。プリザンターのバージョンは 1.3.20.0 です。Google Chrome でやっています。
javascript,html,cssともに初心者です。調べながら、やってみながら、きっとこうすればいいんだ！という感じで書いていますので、間違っている場合、効率的な書き方ではない可能性が大いにあります。間違ってるよ！とか、こうしたほうがいいよ！ということがありましたら、コメント等で教えていただけると大変ありがたいです。

１．使用するサイト
２．分類項目で絞り込み出力するコード
３．複数の条件を指定する
- （１）分類Aが100、または300,500 を指定したいとき
- （２）分類Aが100、分類Cが「セット」を指定したいとき
４．説明項目、選択肢を設定していない分類項目、タイトル等
５．数値
５．日付項目の指定方法
６.チェック項目の指定方法
７．複数の条件で出力するコードの例
８.最後に
９.参考とさせていただいた記事

１．使用するサイト

前回と同じです

２．分類項目で絞り込み出力するコード

（１）コード

サイトは前回のサイトを利用します。途中の「ここからフィルターを設定」から「ここまで」が変更した箇所です。

分類Aが 100 のレコードだけを出力します。

Sub pleasanter_export2()
    Const myApikey As String = "abcde12345"　　　　'変更要：自身のAPIキーを設定
       
    Dim jsonRequest     As Dictionary
    Dim parseResponse   As Dictionary
    Dim httpRequest     As Object
    
    Set jsonRequest = New Dictionary
    
    jsonRequest.Add "ApiVersion", "1.1"
    jsonRequest.Add "ApiKey", myApikey
    
    '******* ここからフィルターを設定 ************
    'jsonRequestにViewを追加、値には新しい空のディクショナリをセット
    jsonRequest.Add "View", New Dictionary
    '追加したViewのディクショナリに キー=ColumnFilterHash 、値＝新しい空のディクショナリをセット
    jsonRequest("View").Add "ColumnFilterHash", New Dictionary
    '追加したViewのColumnFilterHashディクショナリに キー=ClassA,値=[100]をセット
    jsonRequest("View")("ColumnFilterHash").Add "ClassA", "[""100""]"
    
'**************** ここまで *******************
    
    Set httpRequest = CreateObject("msxml2.xmlhttp")
    
    httpRequest.Open "POST", "http://localhost/api/items/426/get"    'サイトID426は変更要
    httpRequest.setRequestHeader "Content-Type", "application/json;charset=utf-8"
    
    httpRequest.send JsonConverter.ConvertToJson(jsonRequest)
    
    Do While httpRequest.readyState < 4
        DoEvents
    Loop

    Set parseResponse = JsonConverter.ParseJson(httpRequest.responseText)
    
    If parseResponse("Response")("Data").Count <= 0 Then
        MsgBox "なし"
        Exit Sub
    End If
    
    Dim responseData As Variant
    Dim i As Long: i = 2
    For Each responseData In parseResponse("Response")("Data")
        With ActiveSheet
            .Cells(i, 1).Value = responseData("Title")
            .Cells(i, 2).Value = responseData("ClassHash")("ClassA")
            .Cells(i, 3).Value = responseData("ClassHash")("ClassB")
            .Cells(i, 4).Value = responseData("ClassHash")("ClassC")
            .Cells(i, 5).Value = responseData("NumHash")("NumA")
            .Cells(i, 6).Value = responseData("NumHash")("NumB")
            .Cells(i, 7).Value = responseData("DateHash")("DateA")
            .Cells(i, 8).Value = responseData("DescriptionHash")("DescriptionA")
            .Cells(i, 9).Value = responseData("CheckHash")("CheckA")
            .Cells(i, 10).Value = responseData("CheckHash")("CheckB")
            .Cells(i, 11).Value = responseData("Owner")
            .Cells(i, 12).Value = responseData("UpdatedTime")
            .Cells(i, 13).Value = responseData("Updator")
            .Cells(i, 14).Value = responseData("Creator")
            .Cells(i, 15).Value = responseData("ResultId")
        End With
        i = i + 1
    Next

    MsgBox "出力完了"
End Sub

（２）結果

分類Aが100のレコードだけが出力できました！

（３）コードの解説

前回と同じ部分の解説は割愛します。前回の記事を参考としてください。
jsonRequestのViewの部分を作成するところからの解説です。

jsonRequest.Add "View", New Dictionary

プリザンターにほいっと投げる jsonRequest に View 部分を追加しています。
キーは View 、値は空の新しいディクショナリ（①）です。

jsonRequest("View").Add "ColumnFilterHash", New Dictionary

View のディクショナリに ColumnFilterHash を追加。
キーは ColumnFilterHash 、値は空の新しいディクショナリ（②）。

jsonRequest("View")("ColumnFilterHash").Add "ClassA", "[""100""]"

②のディクショナリにキー= ClassA 、値= [“100”] をセット。

いやはや。混乱しますよね。私は混乱しています。ディクショナリの入れ子ですね。

イメージとして、こんな感じかなあ。と。
（イメージがしやすいように上記のコードより、条件を増やしています）

（４）条件の指定の際のダブルクォーテーションの使い方

分類項目の条件を指定するのに

“ClassA”, “[“”100″”]”

としています。

なぜダブルクォーテーションがたくさんある？？？

本当に渡したい文字列としては　[“100”] です。

文字列として渡したいのでダブルクォーテーションで囲み “[“100”]“ としたいところです。

しかしこのままではダブルクォーテーションで囲まれたところは” [” と “]” になってしまい、「あれ？間の100はどうなる？」という、おかしな状況におかれてしまいます。

そこで 100 を囲んでるダブルクォーテーションは意味のないただの文字列ですよ、としたい。

その場合、エスケープ文字を前において「これは意味のないただの文字列です！」と主張します。

javaScriptの場合、エスケープ文字は\なので “[\“100\“]” とします。

VBAの場合、エスケープ文字がダブルクォーテーションなので、 “[““100““]” とします。

エスケープしたい文字とエスケープ文字が同じだからややこしいんです！

私はまずエスケープの ” は入れずに “[“100″,”200″]” とやって、そのあとにエスケープしたいダブルクォーテーションのまえに”を入れていきます。そうするとちょっとやりやすい？
“[“100″,”200”]”　＝＞　”[““100““,““200““]”

（５）別解：100を文字列としてではなく数値として指定しても通った。

なお、数値として指定してもいけるか？と試しにそのまま[100]と指定してもいけました。

jsonRequest("View")("ColumnFilterHash").Add "ClassA", "[100]"

３．複数の条件を指定する

（１）分類Aが100、または300,500 を指定したいとき

jsonRequest("View")("ColumnFilterHash").Add "ClassA", "[""100"",""300"",""500""]"

（２）分類Aが100、分類Cが「セット」を指定したいとき

分類Bは選択肢が保存する値と表示する文字列が同じなので、100,200等の指定ではなく文字列で指定します。

jsonRequest("View")("ColumnFilterHash").Add "ClassA", "[""100""]"
jsonRequest("View")("ColumnFilterHash").Add "ClassC", "[""セット""]"

このようにどんどん jsonRequest(“View”)(“ColumnFilterHash”) に追加していけばいいんですね。

４．説明項目、選択肢を設定していない分類項目、タイトル等

説明項目はシンプルでした。普通に “”　で囲って、文字列をわたしてやればよいみたい。
他の項目は [] で囲うので、配列で渡す、ということになっているのかな。

jsonRequest("View")("ColumnFilterHash").Add "DescriptionA", "追加分"

選択肢を設定していない、つまり、入力時にプルダウンリストが表示されない説明項目と同じような分類項目については、説明項目と同じように [] なしの文字列で渡してやればよいみたいです。
ということに気が付かず、[] でくくってなぜ出ない・・・と半日悩んだ過去あり。

jsonRequest("View")("ColumnFilterHash").Add "ClassB", "小麦粉"

タイトルも今回はベタ打ちタイトルなので、同様にただの文字列を渡します。

jsonRequest("View")("ColumnFilterHash").Add "Title", "タイトル93"

基本的に、「〇〇を含む」という指定になるっぽいです。
完全一致や、前方一致など詳細を指定したい場合の対応をこちらで書いています。

５．数値

数値Bがが10に等しい

jsonRequest("View")("ColumnFilterHash").Add "NumB", "[10]"

または

jsonRequest("View")("ColumnFilterHash").Add "NumB", [10]

jsonRequest("View")("ColumnFilterHash").Add "NumB", "[""10""]"

数字自体は文字列と指定しなくてよいのでダブルクォーテーションで囲まなくてOK。だけど囲ってもOKみたい。

条件	指定方法
10に等しい	“[10]”
10または20	“[10,20]”
100以下	“[“”,100″”]”
1000以上	“[“”1000,””]”
100以上200以下	“[“”100,200″”]”

数値項目の指定方法

５．日付項目の指定方法

一日であっても〇〇以上、〇〇以下の指定になるようです。
日付Aが2023/6/10に等しい

jsonRequest("View")("ColumnFilterHash").Add "DateA", "[""2023/06/10 00:00:00,2023/06/10 23:59:59""]"

なお、桁は二けたにしなくてもいけました。

jsonRequest("View")("ColumnFilterHash").Add "DateA", "[""2023/6/10 0:0:0,2023/6/10 23:59:59""]"

条件	指定方法
2023/6/10	“[“”2023/06/10 00:00:00,2023/06/10 23:59:59″”]”
2023/6/10～2023/6/15	“[“”2023/06/10 00:00:00,2023/06/15 23:59:59″”]”
2023/6/20以降	“[“”2023/06/20 00:00:00,””]”
2023/6/20以前	“[“”,2023/06/20 23:59:59″”]”

日付項目の指定方法

６.チェック項目の指定方法

チェックAがチェックオン（TRUE）、チェックBがチェックオフ（FALSE）

jsonRequest("View")("ColumnFilterHash").Add "CheckA", True
jsonRequest("View")("ColumnFilterHash").Add "CheckB", False

７．複数の条件で出力するコードの例

分類Aが100または200、かつ数値Aが1000以上、かつチェックAがオン、かつ日付Aが6/10～6/20。
コードが長くなってしまうので、出力項目を絞っています。

Sub pleasanter_export2()
    Const myApikey As String = "12345abcde"
       
    Dim jsonRequest     As Dictionary
    Dim parseResponse   As Dictionary
    Dim httpRequest     As Object
    
    Set jsonRequest = New Dictionary
    
    jsonRequest.Add "ApiVersion", "1.1"
    jsonRequest.Add "ApiKey", myApikey
    
    '******* ここからフィルターを設定 ************
    
    jsonRequest.Add "View", New Dictionary
    jsonRequest("View").Add "ColumnFilterHash", New Dictionary
    jsonRequest("View")("ColumnFilterHash").Add "ClassA", "[""100"",""200""]"
    jsonRequest("View")("ColumnFilterHash").Add "NumA", "[""100,""]"
    jsonRequest("View")("ColumnFilterHash").Add "CheckA", True
    jsonRequest("View")("ColumnFilterHash").Add "DateA", "[""2023/06/10 00:00:00,2023/06/20 23:59:59""]"
    
    '**************** ここまで *******************
    
    Set httpRequest = CreateObject("msxml2.xmlhttp")
    
    httpRequest.Open "POST", "http://localhost/api/items/426/get"
    httpRequest.setRequestHeader "Content-Type", "application/json;charset=utf-8"
    
    httpRequest.send JsonConverter.ConvertToJson(jsonRequest)
    
    Do While httpRequest.readyState < 4
        DoEvents
    Loop

    Set parseResponse = JsonConverter.ParseJson(httpRequest.responseText)
    
    If parseResponse("Response")("Data").Count <= 0 Then
        MsgBox "なし"
        Exit Sub
    End If
    
    Dim responseData As Variant
    Dim i As Long: i = 2
    For Each responseData In parseResponse("Response")("Data")
        With ActiveSheet
            .Cells(i, 1).Value = responseData("Title")
            .Cells(i, 2).Value = responseData("ClassHash")("ClassA")
            .Cells(i, 3).Value = responseData("NumHash")("NumA")
            .Cells(i, 3).Value = responseData("CheckHash")("CheckA")
            .Cells(i, 4).Value = responseData("DateHash")("DateA")
        End With
        i = i + 1
    Next

    MsgBox "出力完了"
End Sub