230 lines
6.7 KiB
QBasic
230 lines
6.7 KiB
QBasic
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 |