Attribute VB_Name = "Module1"
Option Explicit
'******************************************************************************
'REST API呼出処理
'　プリザンターの任意のテーブルからデータを取得するはん用ツール
Public apiKey As String
Public baseURL As String

Sub run()
    Call getDataFromPleasanterTable
End Sub

Function getDataFromPleasanterTable()
    Debug.Print "------ START ------"
    Application.ScreenUpdating = False '画面更新停止
    Application.Calculation = xlManual '自動計算停止

    '****************************************
    '初期化
    Call init
    '****************************************

    '取得設定シート
    Dim ws設定 As Worksheet
    Set ws設定 = ThisWorkbook.Sheets("取得設定")

    '取得したいテーブルIDを指定
    Dim テーブルID As String
    テーブルID = ws設定.Range("テーブルID").Value

    '出力シート名
    Dim 出力シート名 As String
    出力シート名 = ws設定.Range("出力シート名").Value
    If 出力シート名 = "" Then
        出力シート名 = テーブルID & "_データ"
    End If

    '共通変数
    Dim apiUrl As String
    Dim apiUrlParam As String

    'リクエストURL
    apiUrl = baseURL & "/pleasanter/api/items/" & テーブルID & "/"
    apiUrlParam = "export"

    'ヘッダ
    Dim apiHeaders As New Dictionary
    apiHeaders.Add "Content-Type", "application/json;charset=utf-8"

    'リクエストデータ
    Dim apiBody As New Dictionary
    apiBody.Add "ApiVersion", "1.1"
    apiBody.Add "ApiKey", apiKey

    'フィルタ変数
    Dim colFilter As New Dictionary
    Dim i As Long
    For i = 8 To 17
        If ws設定.Cells(i, 5).Value <> "" Then
            colFilter.Add ws設定.Cells(i, 2).Value, ws設定.Cells(i, 5).Value
        End If
    Next i
    For i = 3 To 22
        If ws設定.Cells(i, 10).Value <> "" And ws設定.Cells(i, 11).Value <> "" And ws設定.Cells(i, 13).Value <> "" Then 'J列, K列, M列
            colFilter.Add ws設定.Cells(i, 12).Value, ws設定.Cells(i, 13).Value  'L列, M列
        End If
    Next i

    'ソート指定
    Dim colSorter As New Dictionary
    For i = 8 To 17
        If ws設定.Cells(i, 6).Value <> "" Then
            colSorter.Add ws設定.Cells(i, 2).Value, ws設定.Cells(i, 7).Value
        End If
    Next i
    For i = 3 To 22
        If ws設定.Cells(i, 15).Value <> "" And ws設定.Cells(i, 16).Value <> "" And ws設定.Cells(i, 18).Value <> "" Then 'O列, P列, R列
            colSorter.Add ws設定.Cells(i, 17).Value, ws設定.Cells(i, 19).Value  'Q列, S列
        End If
    Next i

    'View変数
    Dim view As New Dictionary
    view.Add "ColumnFilterHash", colFilter
    view.Add "ColumnSorterHash", colSorter
    apiBody.Add "View", view

    'HTTPリクエスト送信メソッド呼び出し
    Dim res As Object
    Set res = callRestApi("POST", apiUrl, apiUrlParam, apiHeaders, apiBody)

    If res("StatusCode") = 200 Then
        Debug.Print "------ データの取得に成功しました"

        'データ保存
        Dim csvData As Variant
        csvData = res("Response")("Content")
        Call データ保存(csvData, 出力シート名)
    End If

    Application.Calculation = xlAutomatic '自動計算開始
    Application.ScreenUpdating = True '画面更新開始
    Debug.Print "------ "
    Debug.Print "------ END ------"
End Function

Function init()
    'パブリック変数に値を格納
    'Pleasanter API KEY
    apiKey = "6504c8a807677a3a576e10327f3c19876c55736ee45d4a845796b9e7f5e087bfd4bd0d8184863da8cf1733ca635111432ab334aea59102b06a96ee6d2c05190d"
    baseURL = "https://nextoffice.Next-hd.co.jp"

End Function

Function データ保存(csvData As Variant, targetSheet As String)
    Debug.Print "------ CSVデータをシートに出力開始"

    'targetSheetが存在しない場合は新規作成
    If Not シート確認(targetSheet) Then
        ThisWorkbook.Sheets.Add After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
        ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Name = targetSheet
    End If

    'CSVデータを「テーブル」部分に出力する処理
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets(targetSheet & "")
    ws.Cells.ClearContents

    'csvDataを一時ファイルに保存
    Dim tempFilePath As String
    tempFilePath = Environ("TEMP") & "\pleasanter_temp.csv"

    Dim fileNum As Integer
    fileNum = FreeFile
    Open tempFilePath For Output As #fileNum
    Print #fileNum, csvData
    Close #fileNum

    Debug.Print "一時ファイルに保存: " & tempFilePath

    Dim tempWb As Workbook
    Set tempWb = Workbooks.Open(tempFilePath)

    Dim tempWs As Worksheet
    Set tempWs = tempWb.Sheets(1)

    tempWs.UsedRange.Copy ws.Range("A1")

    tempWb.Close SaveChanges:=False
    Kill tempFilePath



    Debug.Print "------ "
    Debug.Print "------ CSVデータをシートに出力完了"
End Function


'******************************************************************************
'REST API呼出処理
'　method　GetかPOSTか
'　url　REST APIのURL
'　urlParam　リクエストパラメータ（オプション）
'　headers　ヘッダ（オプション）
Function callRestApi(Byval method As String, Byval url As String, Optional Byval urlParam As String = "", Optional Byval headers As Dictionary = Null, Optional Byval body As Dictionary = Null) As Object

    'HTTPリクエストのオブジェクトを定義
    Dim objHTTP As Object
    Set objHTTP = New XMLHTTP60

    'HTTPリクエストの接続先を設定
    objHTTP.Open method, url & urlParam, False

    'リクエストヘッダーを設定（複数ある場合はsetRequestHeaderを複数書けば良いのだ〜）
    Dim i As Long
    For i = 0 To headers.count - 1
        objHTTP.setRequestHeader headers.keys(i), headers.items(i)
    Next i

    'リクエスト送信
    objHTTP.send JsonConverter.ConvertToJson(body)

    Do While objHTTP.readyState < 4
        DoEvents
    Loop

    'レスポンスの文字列（objHTTP.responseText）をJsonに変換して返却
    Set callRestApi = JsonConverter.ParseJson(objHTTP.responseText)

End Function

'シートの存在確認
Function シート確認(SheetName As String, Optional wb As Excel.Workbook) As Boolean
    Dim Sh As Excel.Worksheet
    If wb Is Nothing Then Set wb = ThisWorkbook
        On Error Resume Next
        Set Sh = wb.Sheets(SheetName)
        On Error Goto 0
            シート確認 = Not Sh Is Nothing
End Function