Attribute VB_Name = "Module4"
Option Explicit
'##########################################################################################################
'　callRestApi
'　　　restAPIリクエスト汎用関数
'　getAttachmentsFile
'　　　添付ファイル
'　exportFileList
'　　　取得したファイル情報をシートに保存


'******************************************************************************
'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

'******************************************************************************
'guidから添付ファイルのバイナリデータを取得する
Function getAttachmentsFile(guid As String, saveFolderPath As String) As Boolean
    '共通変数
    Dim apiUrl As String
    Dim apiUrlParam As String
    Dim tableId As String

    'リクエストURL
    apiUrl = baseURL & "/pleasanter/api/binaries/" & guid & "/"
    apiUrlParam = "Get"

    'ヘッダ
    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

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

    If res("StatusCode") = 200 Then
        'ダウンロードしたBase64データをファイル保存
        Dim base64Data As String
        base64Data = res("Response")("Base64")

        '**********************************
        '保存するファイルパスを入力
        Dim saveFilePath As String
        saveFilePath = saveFolderPath & "\" & res("Response")("FileName")

        '**********************************
        'Base64データをデコードして保存
        Dim ret As Long
        ret = DecodeBase64(base64Data, saveFilePath)

        '完了メッセージを表示
        Debug.Print "ファイルの保存に成功しました：" & saveFilePath & ":" & ret
        If ret = -1 Then
            getAttachmentsFile = True
        End If
    End If
End Function


'******************************************************************************
'　Base64デコードしてファイル名をつけて保存する（上書き）
'------------------------------------------------------------------------------
'　第１引数：Base64の文字列　第2引数：保存ファイル名
'******************************************************************************
Function DecodeBase64(ByVal Base64Str As String, ByVal filePath As String) As Long
    'ファイルをBase64デコード
    Dim elm As Object
    Dim ret As Long
    Const adTypeBinary = 1
    Const adSaveCreateOverWrite = 2

    ret = -1 '初期化
    On Error Resume Next
    Set elm = CreateObject("MSXML2.DOMDocument").createElement("base64")
    elm.DataType = "bin.base64"
    elm.text = Base64Str
    With CreateObject("ADODB.Stream")
        .Type = adTypeBinary
        .Open
        .Write elm.nodeTypedValue
        .SaveToFile filePath, adSaveCreateOverWrite
        .Close
    End With
    If Err.Number <> 0 Then ret = 0
        On Error GoTo 0
            DecodeBase64 = ret
End Function

Sub jsonToSheetTest()
    Dim jsonStr As String
    Dim targetSheet As String
    Dim targetCol As String

    '保管するシート名
    targetSheet = "JSONデータ"

    '読み込むデータと吐き出す位置
    jsonStr = Range("契約会社json").value
    targetCol = 2
    Call jsonToSheet(jsonStr, targetSheet, targetCol)

    jsonStr = Range("施工会社json").value
    targetCol = 4
    Call jsonToSheet(jsonStr, targetSheet, targetCol)

    jsonStr = Range("契約営業所json").value
    targetCol = 6
    Call jsonToSheet(jsonStr, targetSheet, targetCol)

    jsonStr = Range("契約ブランドjson").value
    targetCol = 8
    Call jsonToSheet(jsonStr, targetSheet, targetCol)

    jsonStr = Range("シリーズjson").value
    targetCol = 10
    Call jsonToSheet(jsonStr, targetSheet, targetCol)

    jsonStr = Range("支払情報JSON").value
    targetCol = 14
    Call jsonToSheet2(jsonStr, targetSheet, targetCol)


End Sub

'******************************************************************************
'json文字列を分解し、指定したシート・セルの位置に展開する
Function jsonToSheet(ByVal jsonStr As String, ByVal targetSheet As String, ByVal targetCol As Long)
    Debug.Print ">>> Json文字列を分析し、シートに書き出す"

    Dim jsonObj As Object
    Dim key1, key2
    Dim item1, item2
    Dim i

    i = 3

    'データクリア
    With Worksheets(targetSheet)
        .Range(.Cells(i, targetCol), .Cells(1000, targetCol + 1)).ClearContents
    End With

    'JSON文字列が空文字の場合終了
    If jsonStr = "" Then
     Exit Function
    End If

    'デシリアライズ
    Set jsonObj = JsonConverter.ParseJson(jsonStr)
    For Each key1 In jsonObj

        If IsObject(jsonObj(key1)) Then
            '中身がオブジェクトの場合はもう一度分解
            For Each key2 In jsonObj(key1)
                item2 = jsonObj(key1)(key2)
                Worksheets(targetSheet).Cells(i, targetCol) = key2
                Worksheets(targetSheet).Cells(i, targetCol + 1) = item2
                i = i + 1
            Next key2
        Else
            item1 = jsonObj(key1)
            Worksheets(targetSheet).Cells(i, targetCol) = key1
            Worksheets(targetSheet).Cells(i, targetCol + 1) = item1
            i = i + 1
        End If

    Next key1


End Function

'******************************************************************************
'json文字列を分解し、指定したシート・セルの位置に展開する その2
'配列タイプ
Function jsonToSheet2(ByVal jsonStr As String, ByVal targetSheet As String, ByVal targetCol As Long)
    Debug.Print ">>> Json文字列を分析し、シートに書き出す その2"

    Dim jsonObj As Object
    Set jsonObj = JsonConverter.ParseJson(jsonStr)

    Dim key1, item1
    Dim obj
    Dim i, j

    i = 3

    For Each obj In jsonObj
        j = targetCol

        For Each key1 In obj
            item1 = obj(key1)
            Worksheets(targetSheet).Cells(i, j) = item1
            j = j + 1
        Next key1

        i = i + 1

    Next obj


End Function