243 lines
6.3 KiB
QBasic
243 lines
6.3 KiB
QBasic
Attribute VB_Name = "Module7"
|
||
Option Explicit
|
||
|
||
'リードタイム、工期計算データインポート
|
||
|
||
Sub getOtherData()
|
||
Application.ScreenUpdating = False '画面更新停止
|
||
Application.Calculation = xlManual '自動計算停止
|
||
|
||
Call init
|
||
'Debug.Print ">>> 関連テーブルのダウンロード 開始"
|
||
|
||
Dim resultId As String
|
||
resultId = Range("ResultId").value
|
||
|
||
If resultId <> "" Then
|
||
'リードタイムデータ取得
|
||
'Debug.Print ">> リードタイムデータ取得開始"
|
||
Call getOtherTableData(resultId, "116503", "R")
|
||
'Debug.Print "<< リードタイムデータ取得完了"
|
||
|
||
'工期計算データ取得
|
||
'Debug.Print ">> 工期計算データ取得開始"
|
||
Call getOtherTableData(resultId, "203147", "K")
|
||
'Debug.Print "<< 工期計算データ取得完了"
|
||
|
||
'追加変更WFデータ取得
|
||
'Debug.Print ">> 追加変更WFデータ取得開始"
|
||
Call getOtherTableData(resultId, "212533", "T")
|
||
'Debug.Print "<< 追加変更WFデータ取得完了"
|
||
|
||
Call getArariDataRequest(resultId)
|
||
|
||
End If
|
||
|
||
Application.Calculation = xlAutomatic '自動計算開始
|
||
Application.ScreenUpdating = True '画面更新開始
|
||
'Debug.Print "<<< 関連テーブルのダウンロード 終了"
|
||
End Sub
|
||
|
||
|
||
|
||
'MSSマスターシートのIDを指定して、関連テーブルから出たを取得する
|
||
Function getOtherTableData(classA, targetId, shName)
|
||
'共通変数
|
||
Dim apiUrl As String
|
||
Dim apiUrlParam As String
|
||
Dim tableId As String
|
||
|
||
'リードタイムテーブルID
|
||
tableId = targetId
|
||
|
||
'リクエストURL
|
||
apiUrl = baseURL & "/pleasanter/api/items/" & tableId & "/"
|
||
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
|
||
|
||
'Filter変数
|
||
Dim colFilter As New Dictionary
|
||
colFilter.Add "ClassA", "[" & classA & "]"
|
||
|
||
'View変数
|
||
Dim view As New Dictionary
|
||
view.Add "ColumnFilterHash", colFilter
|
||
apiBody.Add "View", view
|
||
|
||
'HTTPリクエスト送信メソッド呼び出し
|
||
Dim res As Object
|
||
Set res = callRestApi("POST", apiUrl, apiUrlParam, apiHeaders, apiBody)
|
||
|
||
'Debug.Print res("StatusCode")
|
||
'Debug.Print res("Response")("TotalCount")
|
||
|
||
If res("StatusCode") = 200 Then
|
||
'グローバル変数へ情報格納
|
||
'Debug.Print res("StatusCode")
|
||
|
||
'正常に取得できたらシートへ書き込み
|
||
'Debug.Print "<<< データ取得成功"
|
||
Call exportDataToSheet(res, shName)
|
||
End If
|
||
|
||
|
||
End Function
|
||
|
||
Function exportDataToSheet(res, shName)
|
||
'Debug.Print ">>> データ出力開始"
|
||
Dim sh As Worksheet
|
||
Set sh = Worksheets(shName)
|
||
|
||
'シートをクリア
|
||
sh.Cells.Clear
|
||
|
||
Dim data As New Dictionary
|
||
Dim value
|
||
Dim i, j As Long
|
||
|
||
i = 1
|
||
For Each value In res("Response")("Data")
|
||
data.Add "ResultId", value("ResultId")
|
||
data.Add "Status", value("Status")
|
||
data.Add "ItemTitle", value("ItemTitle")
|
||
data.Add "Updator", value("Updator")
|
||
data.Add "UpdatedTime", stringToDate(value("UpdatedTime"))
|
||
data.Add "Body", value("Body")
|
||
|
||
Dim keys, items, count
|
||
|
||
'Class
|
||
keys = value("ClassHash").keys
|
||
items = value("ClassHash").items
|
||
count = value("ClassHash").count
|
||
For j = 0 To count - 1
|
||
data.Add keys(j), items(j)
|
||
Next j
|
||
'Num
|
||
keys = value("NumHash").keys
|
||
items = value("NumHash").items
|
||
count = value("NumHash").count
|
||
For j = 0 To count - 1
|
||
data.Add keys(j), items(j)
|
||
Next j
|
||
'Date
|
||
keys = value("DateHash").keys
|
||
items = value("DateHash").items
|
||
count = value("DateHash").count
|
||
For j = 0 To count - 1
|
||
data.Add keys(j), stringToDate(items(j))
|
||
Next j
|
||
'Description
|
||
keys = value("DescriptionHash").keys
|
||
items = value("DescriptionHash").items
|
||
count = value("DescriptionHash").count
|
||
For j = 0 To count - 1
|
||
data.Add keys(j), items(j)
|
||
Next j
|
||
'Check
|
||
keys = value("CheckHash").keys
|
||
items = value("CheckHash").items
|
||
count = value("CheckHash").count
|
||
For j = 0 To count - 1
|
||
data.Add keys(j), items(j)
|
||
Next j
|
||
|
||
data.Add "Owner", value("Owner")
|
||
|
||
|
||
Dim k, itemCount As Long
|
||
itemCount = data.count
|
||
For k = 1 To itemCount
|
||
If (i) = 1 Then
|
||
sh.Cells((i), k) = data.keys(k - 1)
|
||
End If
|
||
|
||
sh.Cells((i + 1), k) = data.items(k - 1)
|
||
Next k
|
||
|
||
data.RemoveAll
|
||
|
||
i = i + 1
|
||
Next value
|
||
|
||
'Debug.Print "<<< データ出力完了"
|
||
|
||
End Function
|
||
|
||
|
||
|
||
'すべての追加変更WF申請データ（未完了分）を取得する
|
||
Sub getAllTsuihenList()
|
||
Application.ScreenUpdating = False '画面更新停止
|
||
Application.Calculation = xlManual '自動計算停止
|
||
|
||
Call init
|
||
'Debug.Print ">>> すべての追加変更WF申請データ（未完了分）を取得 開始"
|
||
|
||
Dim shName
|
||
shName = "T"
|
||
|
||
'共通変数
|
||
Dim apiUrl As String
|
||
Dim apiUrlParam As String
|
||
Dim tableId As String
|
||
|
||
'リードタイムテーブルID
|
||
tableId = "212533"
|
||
|
||
'リクエストURL
|
||
apiUrl = baseURL & "/pleasanter/api/items/" & tableId & "/"
|
||
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
|
||
|
||
'Filter変数
|
||
Dim colFilter As New Dictionary
|
||
colFilter.Add "Status", "[100,101,200]"
|
||
|
||
Dim colSorter As New Dictionary
|
||
colSorter.Add "Status", "desc"
|
||
|
||
'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)
|
||
|
||
'Debug.Print res("StatusCode")
|
||
'Debug.Print res("Response")("TotalCount")
|
||
|
||
If res("StatusCode") = 200 Then
|
||
'グローバル変数へ情報格納
|
||
'Debug.Print res("StatusCode")
|
||
|
||
'正常に取得できたらシートへ書き込み
|
||
'Debug.Print "<<< データ取得成功"
|
||
Call exportDataToSheet(res, shName)
|
||
End If
|
||
|
||
Application.Calculation = xlAutomatic '自動計算開始
|
||
Application.ScreenUpdating = True '画面更新開始
|
||
'Debug.Print "<<< すべての追加変更WF申請データ（未完了分）を取得 終了"
|
||
|
||
End Sub
|