Attribute VB_Name = "Module1"
Option Explicit

'******************************************************************************
'シート名
Public shMSSdata As String
Public shMSSattach As String
Public shMSSlist1 As String
Public shMSSlist2 As String

Public shMSSattach2 As String
Public shMSSlist3 As String

Public thList As String

'共通変数F
Public keiyakuCode As String
Public workFolder As String
Public customerName As String
Public currentDirPath As String
Public apiKey As String
Public baseURL As String

'組織リスト
Public DeptsList As New Dictionary


'フォルダ名に使用できない文字一覧
Public invalidChars As String

'******************************************************************************
Function init()
    'パブリック変数に値を格納
    shMSSdata = "MSSデータ"
    shMSSattach = "MSS添付"
    shMSSlist1 = "MSSデータ一覧"
    shMSSlist2 = "MSSリスト"

    shMSSattach2 = "お客様データ添付"
    shMSSlist3 = "お客様データリスト"

    thList = "WF追加変更申請"


    currentDirPath = Application.ThisWorkbook.Path
    invalidChars = "<>/\\:*?" & Chr(34) & Chr(39) & Chr(0) & Chr(60) & Chr(62) & Chr(42) & Chr(124) & Chr(58) & Chr(160)

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

    'ダウンロードファイルを保存するフォルダのパスを作成
    Dim class200 As String
    class200 = Range("レコード名").value
    If class200 <> "" Then
        'フォルダ名に使えない文字を削除
        Dim i As Integer
        For i = 1 To Len(invalidChars)
            class200 = Replace(class200, Mid(invalidChars, i, 1), "")
        Next i
        'スペースをアンダースコアに置き換え
        class200 = Replace(class200, " ", "")
        class200 = Replace(class200, "　", "")
        workFolder = class200
    Else
        workFolder = ""
    End If

End Function


Sub getFileDownloadList1()
    'Debug.Print ">>> 指定された添付ファイルを一括ダウンロード 開始"
    Call init

    Dim listCount As Long
    Dim fileCount As Long

    Dim hyplink As Hyperlink

    'ダウンロードログ欄のクリア
    Dim g1 As Long
    g1 = 12
    Dim g2 As Long
    g2 = Worksheets(shMSSattach).Cells(Rows.count, 8).End(xlUp).Row
    If g2 >= g1 Then
        With Worksheets(shMSSattach).Range(Worksheets(shMSSattach).Cells(g1, 8), Worksheets(shMSSattach).Cells(g2, 8))
            .ClearContents
            .Hyperlinks.Delete
            .Font.Color = RGB(0, 0, 0)
            .Font.Underline = False
            .Font.Bold = False
        End With
    End If

    'クリア
    With Worksheets(shMSSattach).Range("H9")
        .ClearContents
        .Hyperlinks.Delete
        .Font.Color = RGB(0, 0, 0)
        .Font.Underline = False
        .Font.Bold = False
    End With

    Worksheets(shMSSattach).Cells(g1, 8).value = "---ダウンロード開始---"

    listCount = Worksheets(shMSSattach).Cells(Rows.count, 1).End(xlUp).Row
    Dim i As Long
    '添付ファイルシートより、DL指定されている項目からGuidリストを取得
    For i = 2 To listCount
        If Worksheets(shMSSattach).Cells(i, 6) = 1 Then
            If Worksheets(shMSSattach).Cells(i, 5) > 0 Then
                '**********************************
                '顧客別フォルダが存在するか確認
                Dim fso As Object
                Set fso = CreateObject("Scripting.FileSystemObject")

                If Not fso.FolderExists(currentDirPath & "\" & workFolder) Then
                    'ない場合はフォルダを作成
                    fso.CreateFolder (currentDirPath & "\" & workFolder)

                End If

                '保存ディレクトのリンク作成
                Worksheets(shMSSattach).Range("H9").value = workFolder
                Set hyplink = ActiveSheet.Hyperlinks.Add( _
                Anchor:=Worksheets(shMSSattach).Range("H9"), _
                Address:=workFolder)

                '保存するディレクトリ確認
                Dim saveFolderPath As String
                Dim docName As String
                Dim docNumber As String
                docName = Worksheets(shMSSattach).Cells(i, 2).value '項目の名前
                docNumber = Worksheets(shMSSattach).Cells(i, 1) '項目の番号

                Dim charCount As Integer
                For charCount = 1 To Len(invalidChars)
                    docName = Replace(docName, Mid(invalidChars, charCount, 1), "")
                Next charCount
        
                saveFolderPath = currentDirPath & "\" & workFolder & "\" & docNumber & "." & docName
        
                '項目名フォルダが存在するか確認
                If Not fso.FolderExists(saveFolderPath) Then
                    'ない場合はフォルダを作成
                    fso.CreateFolder (saveFolderPath)
                End If

                Dim j As Long
                j = Worksheets(shMSSattach).Cells(i, 4) '項目の列座標
                fileCount = Worksheets(shMSSattach).Cells(Rows.count, j).End(xlUp).Row 'ファイルGuidリストの末尾行座標

                '取得したGuidリストを元にダウンロード開始
                Dim k As Long


                For k = 4 To fileCount
                    Dim guid As String
                    Dim fileName As String
                    fileName = Worksheets(shMSSattach).Cells(k, j + 1).value
                    guid = Worksheets(shMSSattach).Cells(k, j).value
                    'Debug.Print "ファイルDL: " & fileName

                    'ダウンロード処理
                    Dim result As Boolean
                    result = getAttachmentsFile(guid, saveFolderPath)

                    'ダウンロード履歴保存
                    If result = True Then
                        g2 = Worksheets(shMSSattach).Cells(Rows.count, 8).End(xlUp).Row + 1
                        Worksheets(shMSSattach).Cells(g2, 8).value = docNumber & "." & docName & "\" & fileName
                        Set hyplink = ActiveSheet.Hyperlinks.Add( _
                        Anchor:=Worksheets(shMSSattach).Cells(g2, 8), _
                        Address:=workFolder & "\" & Worksheets(shMSSattach).Cells(g2, 8).value)
                    End If

                Next k
            End If
        End If
    Next i

    g2 = Worksheets(shMSSattach).Cells(Rows.count, 8).End(xlUp).Row + 1
    Worksheets(shMSSattach).Cells(g2, 8).value = "---ダウンロード終了---"

    'Debug.Print "<<< 指定された添付ファイルを一括ダウンロード 終了"

End Sub


Sub getFileDownloadList2()
    'Debug.Print ">>> 指定されたお客様データ添付ファイルを一括ダウンロード 開始"
    Call init

    Dim listCount As Long
    Dim fileCount As Long

    Dim hyplink As Hyperlink


    'ダウンロードログ欄のクリア
    Dim g1 As Long
    g1 = 13
    Dim g2 As Long
    g2 = Worksheets(shMSSattach2).Cells(Rows.count, 2).End(xlUp).Row
    If g2 >= g1 Then
        With Worksheets(shMSSattach2).Range(Worksheets(shMSSattach2).Cells(g1, 2), Worksheets(shMSSattach2).Cells(g2, 2))
            .ClearContents
            .Hyperlinks.Delete
            .Font.Color = RGB(0, 0, 0)
            .Font.Underline = False
            .Font.Bold = False
        End With
    End If

    '保存フォルダリンク クリア
    With Worksheets(shMSSattach2).Range("B10")
        .ClearContents
        .Hyperlinks.Delete
        .Font.Color = RGB(0, 0, 0)
        .Font.Underline = False
        .Font.Bold = False
    End With

    Worksheets(shMSSattach2).Cells(g1, 2).value = "---ダウンロード開始---"

    listCount = Worksheets(shMSSlist3).Cells(Rows.count, 3).End(xlUp).Row
    Dim i As Long
    'お客様データリストシートより、DL指定されている項目からGuidリストを取得
    For i = 4 To listCount
        If Worksheets(shMSSlist3).Cells(i, 6) = 1 Then
            If Worksheets(shMSSlist3).Cells(i, 5) > 0 Then
                '**********************************
                '顧客別フォルダが存在するか確認
                Dim fso As Object
                Set fso = CreateObject("Scripting.FileSystemObject")

                If Not fso.FolderExists(currentDirPath & "\" & workFolder) Then
                    'ない場合はフォルダを作成
                    fso.CreateFolder (currentDirPath & "\" & workFolder)

                End If

                '保存フォルダリンク リンク作成
                Worksheets(shMSSattach2).Range("B10").value = workFolder
                Set hyplink = ActiveSheet.Hyperlinks.Add( _
                Anchor:=Worksheets(shMSSattach2).Range("B10"), _
                Address:=workFolder)

                '保存するディレクトリ確認
                Dim saveFolderPath As String
                Dim docName As String
                Dim docNumber As String
                docName = Worksheets(shMSSlist3).Cells(i, 2).value '項目の名前
                docNumber = Worksheets(shMSSlist3).Cells(i, 1) '項目の番号
        
                Dim charCount As Integer
                For charCount = 1 To Len(invalidChars)
                    docName = Replace(docName, Mid(invalidChars, charCount, 1), "")
                Next charCount
                
                saveFolderPath = currentDirPath & "\" & workFolder & "\" & docNumber & "." & docName
                
                '項目名フォルダが存在するか確認
                If Not fso.FolderExists(saveFolderPath) Then
                    'ない場合はフォルダを作成
                    fso.CreateFolder (saveFolderPath)
                End If

                Dim j As Long
                j = Worksheets(shMSSlist3).Cells(i, 4) '項目の列座標
                fileCount = Worksheets(shMSSlist3).Cells(Rows.count, j).End(xlUp).Row 'ファイルGuidリストの末尾行座標

                '取得したGuidリストを元にダウンロード開始
                Dim k As Long


                For k = 4 To fileCount
                    Dim guid As String
                    Dim fileName As String
                    fileName = Worksheets(shMSSlist3).Cells(k, j + 1).value
                    guid = Worksheets(shMSSlist3).Cells(k, j).value
                    'Debug.Print "ファイルDL: " & fileName

                    'ダウンロード処理
                    Dim result As Boolean
                    result = getAttachmentsFile(guid, saveFolderPath)

                    'ダウンロード履歴保存
                    If result = True Then
                        g2 = Worksheets(shMSSattach2).Cells(Rows.count, 2).End(xlUp).Row + 1
                        Worksheets(shMSSattach2).Cells(g2, 2).value = docNumber & "." & docName & "\" & fileName
                        Set hyplink = ActiveSheet.Hyperlinks.Add( _
                        Anchor:=Worksheets(shMSSattach2).Cells(g2, 2), _
                        Address:=workFolder & "\" & Worksheets(shMSSattach2).Cells(g2, 2).value)
                    End If

                Next k
            End If
        End If
    Next i

    g2 = Worksheets(shMSSattach2).Cells(Rows.count, 2).End(xlUp).Row + 1
    Worksheets(shMSSattach2).Cells(g2, 2).value = "---ダウンロード終了---"

    'Debug.Print "<<< 指定されたお客様データ添付ファイルを一括ダウンロード 終了"
End Sub


'プリザンターのユーザー情報一覧取得
Sub getPleasanterUsers()
    Application.ScreenUpdating = False '画面更新停止
    Application.Calculation = xlManual '自動計算停止
    'Debug.Print ">>> プリザンターのユーザー情報一覧取得 開始"

    Dim sh As Worksheet
    Set sh = Worksheets("マスターデータ")
    sh.ListObjects("社員リスト").DataBodyRange.Delete
    sh.ListObjects("組織リスト").DataBodyRange.Delete

    Call init

    Call getPleasanterDeptsRequest(0)
    Call getPleasanterUsersRequest(0)

    Application.Calculation = xlAutomatic '自動計算開始
    Application.ScreenUpdating = True '画面更新開始
    'Debug.Print "<<< プリザンターのユーザー情報一覧取得 終了"
End Sub

Function getPleasanterUsersRequest(offset)
    '共通変数
    Dim apiUrl As String
    Dim apiUrlParam As String

    'リクエストURL
    apiUrl = baseURL & "/pleasanter/api/users/"
    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
    apiBody.Add "Offset", offset

    'Filter変数
    Dim colSorter As New Dictionary
    colSorter.Add "UserId", "asc"

    'View変数
    Dim view As New Dictionary
    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
        '正常に取得できたらシートへ書き込み
        'Call exportToSheetData(res)
        'Debug.Print JsonConverter.ConvertToJson(res("Response")("TotalCount"))
        'Debug.Print JsonConverter.ConvertToJson(res("Response")("PageSize"))
        'Debug.Print JsonConverter.ConvertToJson(res("Response")("Offset"))
        'Debug.Print JsonConverter.ConvertToJson(res("Response")("Data").count)
        'Debug.Print "----- 取得成功"

        Call exportUsersList(res)

    End If

    '200以上の場合は再実行
    If res("Response")("PageSize") + res("Response")("Offset") < res("Response")("TotalCount") Then
        Call getPleasanterUsersRequest(offset + 200)
    End If


End Function

'マスターデータシートの社員リストテーブルを更新
Function exportUsersList(res)
    Dim value
    Dim N As Long
    Dim sh As Worksheet
    Set sh = Worksheets("マスターデータ")

    For Each value In res("Response")("Data")
        'Debug.Print value("UserId") & " " & value("LoginId") & " " & value("Name")

        sh.ListObjects("社員リスト").ListRows.Add
        N = sh.ListObjects("社員リスト").ListRows.count
        With sh.ListObjects("社員リスト").ListRows(N)
            .Range(1) = value("UserId")
            .Range(2) = value("LoginId")
            .Range(3) = value("Name")
            .Range(4) = value("DeptCode")
            .Range(5) = DeptsList(value("DeptCode"))
            .Range(6) = ""
        End With

    Next value

End Function

Function getPleasanterDeptsRequest(offset)
    '共通変数
    Dim apiUrl As String
    Dim apiUrlParam As String

    'リクエストURL
    apiUrl = baseURL & "/pleasanter/api/depts/"
    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
    apiBody.Add "Offset", offset

    'Filter変数
    Dim colSorter As New Dictionary
    colSorter.Add "DeptId", "asc"

    'View変数
    Dim view As New Dictionary
    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
        '正常に取得できたらシートへ書き込み
        'Call exportToSheetData(res)
        'Debug.Print JsonConverter.ConvertToJson(res("Response")("TotalCount"))
        'Debug.Print JsonConverter.ConvertToJson(res("Response")("PageSize"))
        'Debug.Print JsonConverter.ConvertToJson(res("Response")("Offset"))
        'Debug.Print JsonConverter.ConvertToJson(res("Response")("Data").count)
        'Debug.Print "----- 取得成功"

        Call exportDeptsList(res)

    End If

    '200以上の場合は再実行
    If res("Response")("PageSize") + res("Response")("Offset") < res("Response")("TotalCount") Then
        Call getPleasanterDeptsRequest(offset + 200)
    End If


End Function

'マスターデータシートの組織リストを更新
Function exportDeptsList(res)
    Dim value
    Dim N As Long
    Dim sh As Worksheet
    Set sh = Worksheets("マスターデータ")

    For Each value In res("Response")("Data")
        DeptsList.Add value("DeptCode"), value("DeptName")

        sh.ListObjects("組織リスト").ListRows.Add
        N = sh.ListObjects("組織リスト").ListRows.count
        With sh.ListObjects("組織リスト").ListRows(N)
            .Range(1) = value("DeptId")
            .Range(2) = value("DeptCode")
            .Range(3) = value("DeptName")
            .Range(4) = value("Body")
        End With

    Next value

End Function

Sub SheetToPdfSave1()
    Call SheetToPdfSave("覚書", "覚書【閲覧専用】")
End Sub

Sub SheetToPdfSave2()
    Call SheetToPdfSave("粗利益確認書(設計契約)", "粗利益確認書(設計契約)【閲覧専用】")
End Sub

Sub SheetToPdfSave3()
    Call SheetToPdfSave("粗利益確認書(本契約)", "粗利益確認書(本契約)【閲覧専用】")
End Sub


'指定したシートを名前をつけてPDF保存
Function SheetToPdfSave(shName, fileName)

    Call init
    '**********************************
    '顧客別フォルダが存在するか確認
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")

    If Not fso.FolderExists(currentDirPath & "\" & workFolder) Then
        'ない場合はフォルダを作成
        fso.CreateFolder (currentDirPath & "\" & workFolder)

    End If
    Dim filePath
    filePath = ThisWorkbook.Path & "\"
    Dim fileName2
    fileName2 = workFolder & "■" & fileName

    '保存先
    Dim saveFile

    saveFile = filePath & workFolder & "\" & fileName2 & ".pdf"

    Debug.Print saveFile

    Worksheets(shName).Range("A1").Select
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, fileName:=saveFile _
    , Quality:=xlQualityStandard, _
    IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True

End Function