Attribute VB_Name = "Module1"
Option Explicit
'共通変数
Public 稟議申請書テーブルID As String
Public MSSテーブルID As String
Public 開始日 As String
Public 終了日 As String

Public エクスポート1 As String
Public エクスポート2 As String

Public apiKey As String
Public baseURL As String

Sub run() 
    Debug.Print "------ START ------"
    '実行確認
    Dim rc As VbMsgBoxResult
    rc = MsgBox("プリザンターから最新の稟議申請書データを取得しますか？" & Chr(13) & "この処理には少々時間が掛かります", vbYesNo + vbQuestion)

    If rc = vbYes Then
        Application.ScreenUpdating = False '画面更新停止
        Application.Calculation = xlManual '自動計算停止

        '初期化
        Call init

        '稟議申請書CSVエクスポート
        Dim resCSV As Variant
        resCSV = 稟議申請書CSVエクスポート(エクスポート1 & "")
        'CSVデータをシートに保存
        Call CSVデータ保存1(resCSV, "稟議申請書")

        'MSSデータCSVエクスポート
        Dim resMSSCSV As Variant
        resMSSCSV = MSSデータCSVエクスポート(エクスポート2 & "")

        'CSVデータをシートに保存
        Call CSVデータ保存1(resMSSCSV, "MSSデータ")

        Application.Calculation = xlAutomatic '自動計算開始
        Application.ScreenUpdating = True '画面更新開始
    Else
        MsgBox "処理を中止します", vbCritical

    End If

    Debug.Print "------ "
    Debug.Print "------ END ------"

End Sub

Function init()
    'パブリック変数に値を格納
    '事業計画テーブル 214737
    稟議申請書テーブルID = Range("稟議申請書テーブルID").Value
    MSSテーブルID = Range("MSSテーブルID").Value
    開始日 = Range("開始日").Value
    終了日 = Range("終了日").Value

    エクスポート1 = Range("エクスポート1").Value
    エクスポート2 = Range("エクスポート2").Value

    'Pleasanter API KEY
    apiKey = "6504c8a807677a3a576e10327f3c19876c55736ee45d4a845796b9e7f5e087bfd4bd0d8184863da8cf1733ca635111432ab334aea59102b06a96ee6d2c05190d"
    baseURL = "https://nextoffice.Next-hd.co.jp"

End Function

Function 稟議申請書CSVエクスポート(exportId As String) As Variant
    '共通変数
    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
    apiBody.Add "ExportId", exportId

    'Filter変数
    Dim colFilter As New Dictionary
    colFilter.Add "Status", "[900]"
    colFilter.Add "ClassC", "[1,3]"
    colFilter.Add "DateA", "[""" & 開始日 & " 00:00:00" & "," & 終了日 & " 23:59:59""]"

    'ソート指定
    Dim colSorter As New Dictionary
    colSorter.Add "DateA", "asc"

    '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 "---- CSVデータの取得に成功しました"
        稟議申請書CSVエクスポート = res("Response")("Content")

    End If

End Function

Function MSSデータCSVエクスポート(exportId As String) As Variant
    '共通変数
    Dim apiUrl As String
    Dim apiUrlParam As String

    'リクエストURL
    apiUrl = baseURL & "/pleasanter/api/items/" & MSSテーブル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
    apiBody.Add "ExportId", exportId

    'Filter変数
    Dim colFilter As New Dictionary

    'ソート指定
    Dim colSorter As New Dictionary
    colSorter.Add "DateA", "asc"

    '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 "---- CSVデータの取得に成功しました"
        MSSデータCSVエクスポート = res("Response")("Content")

    End If

End Function

Function CSVデータ保存1(csvData As Variant, targetSheet As String)
    Debug.Print "------ CSVデータをシートに出力開始"
    'CSVデータを「テーブル」部分に出力する処理
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets(targetSheet & "")
    ws.Cells.ClearContents

    'CSVデータを配列に変換（カンマ区切り・ダブルクォート対応）
    Dim records As Collection: Set records = New Collection
    Dim i As Long, c As String, inQuote As Boolean, field As String, rec As Collection
    Dim pos As Long, l As Long
    l = Len(csvData)
    Set rec = New Collection
    field = ""
    inQuote = False
    For i = 1 To l
        c = Mid(csvData, i, 1)
        If c = '"' Then
            If inQuote And i < l And Mid(csvData, i + 1, 1) = '"' Then
                field = field & '"'
                i = i + 1
            Else
                inQuote = Not inQuote
            End If
        Elseif c = "," And Not inQuote Then
            rec.Add field
            field = ""
        Elseif (c = vbCr Or c = vbLf) And Not inQuote Then
            If field <> "" Or rec.Count > 0 Then
                rec.Add field
                records.Add rec
                Set rec = New Collection
                field = ""
            End If
        Else
            field = field & c
        End If
    Next i
    '最後のフィールド
    If field <> "" Or rec.Count > 0 Then
        rec.Add field
        records.Add rec
    End If

    '最大列数取得
    Dim maxCols As Long: maxCols = 0
    For Each rec In records
        If rec.Count > maxCols Then maxCols = rec.Count
            Next
            '二次元配列化
            Dim arr() As Variant
            ReDim arr(1 To records.Count, 1 To maxCols)
            Dim rowIdx As Long, colIdx As Long
            rowIdx = 1
            For Each rec In records
                For colIdx = 1 To maxCols
                    If colIdx <= rec.Count Then
                        arr(rowIdx, colIdx) = rec(colIdx)
                    Else
                        arr(rowIdx, colIdx) = ""
                    End If
                Next colIdx
                rowIdx = rowIdx + 1
                Next
                'シートに出力
                ws.Range(ws.Cells(1, 1), ws.Cells(UBound(arr, 1), UBound(arr, 2))).Value = arr

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