スポンサーリンク

【pleasanter/VBA】エクスポート⑦200件超のデータを出力する方法 Offset

プリザンター
スポンサーリンク
※当サイトは広告を含みます

エクセルVBAでプリザンターから情報取得、シリーズ。第7回です。

前回までVBAでエクスポートする基本、絞り込み条件の指定方法、ソートの方法、表示名を出力する方法などをやってきました。

しかしそもそも、テスト用のサイトにはじつは299件のレコードがあるのですが、全出力しても200件までしか出ていませんでした。
なぜか?というと、プリザンターは初期設定のままなにも変更していないのですが、初期値ではApiで取得する件数は200件まで、となるようです。
https://pleasanter.org/manual/faq-api-paging

で、全件出したいですよね。Offsetというのを使うと出せそうなので、やってみたいと思います。

なお、VBAでのエクスポートのやり方、フィルター条件のやりかた、は割愛しますので、前回までの記事を参照してください。

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

1.使用するサイトの内容

前回までと同じです。

299件のデータがあります。

2.キーワードは Offset、TotalCount、PageSize

あれこれ見ていて、キーワードは Offset、TotalCount、Date.Count、PageSize あたりに違いない、とあたりを付けました。

Offset、TotalCount、PageSize についてはプリザンター公式サイトに記載がありました。

FAQ:API で 200 レコードを超えるデータを取得するには。
・概要
複数レコードを取得する際 API からの応答に含まれるレコードの件数は Api.json の PageSize(デフォルトで 200) が最大となります。
Offset を指定するとことで、後続のレコードを取得することができます。

・対応方法
レスポンスの TotalCount が、レスポンスの PageSize を超えている場合、取得できていないレコードが存在します。Offset を追加したリクエストをすることで、後続のレコードを取得します。
・レコード件数の確認
以下のようなリクエストを行うと、レコードの件数の情報が取得できます。
このとき
(開始位置 + 一度に取得できる件数) > 全件
となっているかをチェックすることで、未取得のレコードがあることをコード的に判定できます。

引用元:https://pleasanter.org/manual/faq-api-paging

jsonRequest.Add “Offset”, 200 等として、データの読み込み開始位置をずらせるみたいです。
ためしに以下のコードを実行してイミディエイトウインドウを確認します。

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
'offsetに0を指定
jsonRequest.Add "Offset", 0
jsonRequest.Add "View", New Dictionary
jsonRequest("View").Add "ColumnSorterHash", New Dictionary
jsonRequest("View")("ColumnSorterHash").Add "ResultId", "asc"
    
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)
    
Debug.Print "Data.Count:" & parseResponse("Response")("Data").Count
Debug.Print "TotalCount:" & parseResponse("Response")("TotalCount")
Debug.Print "PageSize:" & parseResponse("Response")("PageSize")    

まず、jsonRequest.Add “Offset”, 0 としてコードを実行しました。
イミディエイトウインドウには以下のように出力されました。

次に、jsonRequest.Add “Offset”, 200 としてコードを実行しました。
すると、イミディエイトウインドウには以下のように出力されました。

parseResponse(“Response”)(“TotalCount”) は299のまま変わらず、
parseResponse(“Response”)(“Data”).Count は99となっています。

また、parseResponse(“Response”)(“PageSize”) は200と出ていますので、取得サイズの上限が200ということが分かります。

3.Offsetしてやってみる。

ためしに、Offsetのところを0にして出力した結果、200にして出力した結果を見てみます。
わかりやすいようにResultIDの昇順でソートして出力します。

Sub pleasanter_export12()
    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
'1回目はOffset0で出力
    jsonRequest.Add "Offset", 0
'2回目はOffset200で出力
    'jsonRequest.Add "Offset", 200
    jsonRequest.Add "View", New Dictionary
    jsonRequest("View").Add "ColumnSorterHash", New Dictionary
    jsonRequest("View")("ColumnSorterHash").Add "ResultId", "asc"
    
    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
    
    Debug.Print "Data.Count:" & parseResponse("Response")("Data").Count
    Debug.Print "TotalCount:" & parseResponse("Response")("TotalCount")
    Debug.Print "PageSize:" & parseResponse("Response")("PageSize")
    
    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

1回目

2回目

1回目はちゃんと(?)200レコードでちょん切れています。2回目は201レコードから出力されて、最後の299レコードまで出力されています。

4.TotalCountとpageSizeを利用して全件を出力するコード

コードです。

Sub pleasanter_export12()
    Const myApikey As String = "12345abcde"

    Dim jsonRequest     As Dictionary
    Dim parseResponse   As Dictionary
    Dim httpRequest     As Object
’※1
    Dim offsetCnt As Long: offsetCnt = 0
    Dim endFlg As Boolean: endFlg = False
    Dim i As Long: i = 2
’※2 
    Do Until endFlg = True
’※3   
        Set jsonRequest = New Dictionary
        jsonRequest.Add "ApiVersion", "1.1"
        jsonRequest.Add "ApiKey", myApikey
        jsonRequest.Add "Offset", offsetCnt
        jsonRequest.Add "View", New Dictionary
        jsonRequest("View").Add "ColumnSorterHash", New Dictionary
        jsonRequest("View")("ColumnSorterHash").Add "ResultId", "asc"
        
        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)
’※4         
        If parseResponse("Response")("TotalCount") = 0 Then
            MsgBox "出力データなし"
            Exit Sub
        End If
’※5        
        If offsetCnt + parseResponse("Response")("PageSize") >= parseResponse("Response")("TotalCount") Then
            endFlg = True
        Else
            offsetCnt = offsetCnt + parseResponse("Response")("PageSize")
        End If
        
        Dim responseData As Variant
        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
        
        Set jsonRequest = Nothing
        Set httpRequest = Nothing
        Set parseResponse = Nothing
        
    Loop

    MsgBox "出力完了"
End Sub

※印のところを解説します。ほかは割愛します。

’※1
    Dim offsetCnt As Long: offsetCnt = 0
    Dim endFlg As Boolean: endFlg = False
    Dim i As Long: i = 2

変数の準備です。
offsetCntではオフセットの開始位置を指定します。初期値には0を入れておきます。
endFlgは、ループを終了するかどうかのフラグです。ループ終了条件となったらendFlgをTrueにします。
i はエクセルワークシートの出力行です。初期値に2を入れています。出力するごとに1をプラスしていきます。

’※2 
    Do Until endFlg = True
      ここに出力処理
    Loop

endFlg が True になるまでプリザンターからのデータ取得&エクセル出力の処理を繰り返します。
endFlgがTrueの場合はループを終了します。

’※3   
    Set jsonRequest = New Dictionary
    jsonRequest.Add "ApiVersion", "1.1"
    jsonRequest.Add "ApiKey", myApikey
    jsonRequest.Add "Offset", offsetCnt
    jsonRequest.Add "View", New Dictionary
    jsonRequest("View").Add "ColumnSorterHash", New Dictionary
    jsonRequest("View")("ColumnSorterHash").Add "ResultId", "asc"

jsonRequest.Add “Offset”, offsetCnt のところで、Offsetに初回は0をセットします。
2ループ目では200、3ループ目では400をセットすることになります。

結果が分かりやすいように、ColumnSorterHash でResultId昇順になるように設定しています。

ちなみに、上記のjsonRequestをjson形式にしたイメージは以下のようになっています。
vbaではディクショナリにしていますが、json形式にパースしたイメージはdebug.printすることでイミディエイトウインドウに出力できます。
Debug.Print JsonConverter.ConvertToJson(jsonRequest)

’※4         
    If parseResponse("Response")("TotalCount") = 0 Then
        MsgBox "出力データなし"
        Exit Sub
    End If

TotalCountを検査して、0の場合はそもそもデータがないので、ExitSubで処理を終了します。

’※5        
    If offsetCnt + parseResponse("Response")("PageSize") >= parseResponse("Response")("TotalCount") Then
        endFlg = True
    Else
        offsetCnt = offsetCnt + parseResponse("Response")("PageSize")
    End If

ここが貧弱な脳みその私には難しかった。
上記引用したFAQで
(開始位置 + 一度に取得できる件数) > 全件
とある。

1回目
offsetCnt(0) + PageSize(200) = 200
totalCount = 299
totalCount の方が大きいので endFlg はFalseのまま
 Elseの処理に流れ、offsetCnt に PageSize(200) をプラス

2回目
 offsetCnt(200) + PageSize(200) = 400
totalCount = 299
totalCount の方が小さいので endFlg を true にする
 次のループには進まない。

5.別解のコード

ほかの方法でもできそうだなあと、TotalCountとPageSizeから最初に必要ループ回数を求める方法でもやってみました。でも、4の方がすっきりしていいような気がします。
出力件数が多い場合は以下のコードのようにいったん配列に蓄積しておいて、最後にまとめてワークシートに出力するほうが処理速度が早い(はず)です。

変更点
・最初にTotalCountとPageSizeでループ回数を決める。
・ループを繰り返すような大きな出力になる場合、レコードごとにエクセルに出力していると時間がかかるので、いったん配列に入れてから出力する。

解説に代えてコメント多めに入れています。

Sub pleasanter_export13()
    Const myApikey As String = "12345abcde"
       
    Dim jsonRequest     As Dictionary
    Dim parseResponse   As Dictionary
    Dim httpRequest     As Object
    Dim offsetCnt As Long: offsetCnt = 0        'オフセット
    Dim totalCount As Long                      '全件件数
    Dim pageSize As Long                        'ページサイズ
    Dim loopCnt As Long: loopCnt = 1            'ループ回数カウント用
    Dim maxloopCnt As Long: maxloopCnt = -1     '必要ループ回数。初期値に-1を代入しておく
    Dim arr() As Variant                        '出力データを一時格納しておく配列
    Dim idx As Long: idx = 1                    '配列行方向インデックス
    
    Do
        Set jsonRequest = New Dictionary
        
        jsonRequest.Add "ApiVersion", "1.1"
        jsonRequest.Add "ApiKey", myApikey
        jsonRequest.Add "Offset", offsetCnt
        jsonRequest.Add "View", New Dictionary
        jsonRequest("View").Add "ColumnSorterHash", New Dictionary
        jsonRequest("View")("ColumnSorterHash").Add "ResultId", "asc"
        
        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)
        
        '最初のループでのみ(maxloopCntが-1であることで初回ループであることを判定)以下のIf文に進み
        'ループ回数を決定、および配列のサイズを再宣言して確定
        If maxloopCnt = -1 Then
            totalCount = parseResponse("Response")("TotalCount")    '全件件数
            pageSize = parseResponse("Response")("PageSize")        'ページサイズ
            '件数が0件の場合、処理終了
            If totalCount = 0 Then
                MsgBox "出力データなし"
                Exit Sub
            Else
            '全件件数÷ページサイズの切り上げでループ回数を決定
                maxloopCnt = Application.WorksheetFunction.RoundUp(totalCount / pageSize, 0)
            'データを一時格納する配列の再宣言(縦:全件件数、横:必要なカラム数)
                ReDim arr(1 To totalCount, 1 To 15)
            End If
        End If
        
        Dim responseData As Variant
        For Each responseData In parseResponse("Response")("Data")
            arr(idx, 1) = responseData("Title")
            arr(idx, 2) = responseData("ClassHash")("ClassA")
            arr(idx, 3) = responseData("ClassHash")("ClassB")
            arr(idx, 4) = responseData("ClassHash")("ClassC")
            arr(idx, 5) = responseData("NumHash")("NumA")
            arr(idx, 6) = responseData("NumHash")("NumB")
            arr(idx, 7) = responseData("DateHash")("DateA")
            arr(idx, 8) = responseData("DescriptionHash")("DescriptionA")
            arr(idx, 9) = responseData("CheckHash")("CheckA")
            arr(idx, 10) = responseData("CheckHash")("CheckB")
            arr(idx, 11) = responseData("Owner")
            arr(idx, 12) = responseData("UpdatedTime")
            arr(idx, 13) = responseData("Updator")
            arr(idx, 14) = responseData("Creator")
            arr(idx, 15) = responseData("ResultId")
            idx = idx + 1
        Next
        
        Set jsonRequest = Nothing
        Set httpRequest = Nothing
        Set parseResponse = Nothing
        
        'ループ数をカウントアップ
        loopCnt = loopCnt + 1
        'オフセット(開始位置)をページサイズ(200)分だけ増加させる
        offsetCnt = offsetCnt + pageSize
        
    'ループ回数(loopCnt)が必要ループ回数(maxLoopCnt)より大きくなったらループ終了
    Loop Until maxloopCnt < loopCnt
    
    '配列の内容をエクセルシートに出力
    With ActiveSheet
        .Range("A2").Resize(UBound(arr), UBound(arr, 2)).Value = arr
    End With

    MsgBox "出力完了"
End Sub

6.最後に

ちょん切れ問題が解決してよかった!

7.参考記事

プリザンター公式マニュアル>FAQ:APIで200レコードを超えるデータを取得する
https://pleasanter.org/manual/faq-api-paging

プリザンターのAPIの取得条件を調べてみた
https://imageinformationsystem.hatenablog.com/entry/2018/12/14/170000

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

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

コメント

タイトルとURLをコピーしました