273 lines
8.4 KiB
QBasic
273 lines
8.4 KiB
QBasic
Attribute VB_Name = "Module2"
|
||
Option Explicit
|
||
'##########################################################################################################
|
||
' selectKeiyakuCode
|
||
' 契約コードを選択し、データを1件分取得
|
||
' getMSSdataRequest
|
||
' お客様データファイルの一覧取得リクエスト
|
||
' exportToSheetData
|
||
' 取得したファイル情報をシートに保存
|
||
|
||
|
||
'******************************************************************************
|
||
'リストから契約コードを選択する
|
||
Sub selectKeiyakuCode()
|
||
Application.ScreenUpdating = False '画面更新停止
|
||
Application.Calculation = xlManual '自動計算停止
|
||
|
||
Call init
|
||
'Debug.Print ">>> MSSからデータを1件取得する処理を開始します"
|
||
|
||
Dim Ad As String 'セル番号用変数
|
||
Dim Col As Integer 'セルの列番号用変数
|
||
Dim Row As Integer 'セルの行番号用変数
|
||
|
||
Ad = ActiveCell.Address
|
||
Col = ActiveCell.Column
|
||
Row = ActiveCell.Row
|
||
|
||
Range("レコードID").value = ""
|
||
Range("レコードタイトル").value = ""
|
||
|
||
'テーブル範囲無いにカーソルがあるときにボタンを押したら、契約コードを取得する
|
||
If Row >= 3 And Row <= 104 And Col >= 4 And Col <= 19 Then
|
||
Dim keiyakuCode As Variant
|
||
keiyakuCode = Worksheets(shMSSlist1).Cells(Row, 13).value
|
||
|
||
'Debug.Print keiyakuCode
|
||
|
||
If keiyakuCode <> 0 Then
|
||
Range("契約コード指定").value = keiyakuCode
|
||
Else
|
||
Range("契約コード指定").value = ""
|
||
Range("レコードID").value = ""
|
||
Range("レコードタイトル").value = ""
|
||
|
||
End If
|
||
End If
|
||
|
||
If Range("契約コード指定").value <> "" Then
|
||
'テーブル外にカーソルがあるとき、個別契約コードに値があったら実行
|
||
If Range("契約コード指定").value = "9999AAABB" Then
|
||
MsgBox "契約コード【9999AAABB】は選択不可"
|
||
Else
|
||
Call getMSSdataRequest(Range("契約コード指定").value)
|
||
End If
|
||
Else
|
||
MsgBox "取得したい情報をリストから選択してください"
|
||
End If
|
||
|
||
Application.Calculation = xlAutomatic '自動計算開始
|
||
Application.ScreenUpdating = True '画面更新開始
|
||
'Debug.Print "<<< MSSからデータを1件取得する処理を終了しました"
|
||
End Sub
|
||
|
||
|
||
'******************************************************************************
|
||
'プリザンターマスターシートから単体データを取得する
|
||
Function getMSSdataRequest(ByVal keiyakuCode As String)
|
||
'共通変数
|
||
Dim apiUrl As String
|
||
Dim apiUrlParam As String
|
||
Dim tableId As String
|
||
|
||
'MSSテーブルID
|
||
tableId = "189112"
|
||
|
||
'リクエスト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", keiyakuCode
|
||
|
||
'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)
|
||
|
||
If res("StatusCode") = 200 And res("Response")("TotalCount") = 1 Then
|
||
'グローバル変数へ情報格納
|
||
keiyakuCode = res("Response")("Data")(1)("ClassHash")("ClassA")
|
||
|
||
'正常に取得できたらシートへ書き込み
|
||
'Debug.Print "個別情報 取得成功"
|
||
Call exportToSheetData(res)
|
||
End If
|
||
|
||
End Function
|
||
|
||
'******************************************************************************
|
||
'プリザンターマスターシートから取得したデータをシートに書き込む
|
||
Function exportToSheetData(res As Object)
|
||
Dim itemTitle As String
|
||
Dim resultId As String
|
||
|
||
itemTitle = res("Response")("Data")(1)("ItemTitle")
|
||
Range("レコードタイトル").value = itemTitle
|
||
|
||
resultId = res("Response")("Data")(1)("ResultId")
|
||
Range("レコードID").value = resultId
|
||
|
||
Dim key, g
|
||
g = 2
|
||
For Each key In res("Response")("Data")(1)
|
||
If IsObject(res("Response")("Data")(1)(key)) Then
|
||
'中身がHashの場合は飛ばす
|
||
Else
|
||
Worksheets(shMSSdata).Cells(g, 26) = key
|
||
Worksheets(shMSSdata).Cells(g, 27) = res("Response")("Data")(1)(key)
|
||
g = g + 1
|
||
End If
|
||
Next key
|
||
|
||
|
||
'最終行を取得
|
||
Dim lastRow As Long
|
||
Dim hashNameList As New Dictionary
|
||
hashNameList.Add 2, "ClassHash"
|
||
hashNameList.Add 5, "NumHash"
|
||
hashNameList.Add 8, "DateHash"
|
||
hashNameList.Add 11, "DescriptionHash"
|
||
hashNameList.Add 14, "CheckHash"
|
||
hashNameList.Add 17, "AttachmentsHash"
|
||
|
||
Dim j As Long
|
||
j = 2
|
||
For j = 2 To 14 Step 3
|
||
'事前にセルをクリア
|
||
Worksheets(shMSSdata).Columns(j + 2).ClearContents
|
||
'Hashリスト名
|
||
Dim hashName As String
|
||
hashName = hashNameList(j)
|
||
|
||
lastRow = Worksheets(shMSSdata).Cells(Rows.count, j).End(xlUp).Row
|
||
Dim i As Long
|
||
For i = 2 To lastRow
|
||
'セル値を取得
|
||
Dim colName As String
|
||
colName = Worksheets(shMSSdata).Cells(i, j).value
|
||
Dim data As Variant
|
||
data = res("Response")("Data")(1)(hashName)(colName)
|
||
|
||
'日付の場合は下処理
|
||
If hashName = "DateHash" Then
|
||
If data = "1899-12-30T00:00:00" Then
|
||
data = ""
|
||
Else
|
||
data = Replace(data, "T", " ")
|
||
End If
|
||
End If
|
||
|
||
Worksheets(shMSSdata).Cells(i, j + 2) = data
|
||
Next i
|
||
Next j
|
||
|
||
'******************************************************************************
|
||
'添付ファイルデータ処理
|
||
'事前にセルをクリア
|
||
Worksheets(shMSSattach).Range("L4:DD100").ClearContents
|
||
'ダウンロードログ欄のクリア
|
||
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
|
||
|
||
|
||
hashName = hashNameList(j)
|
||
Dim jj As Long
|
||
jj = 3
|
||
lastRow = Worksheets(shMSSattach).Cells(Rows.count, jj).End(xlUp).Row
|
||
For i = 2 To lastRow
|
||
'セル値を取得
|
||
colName = Worksheets(shMSSattach).Cells(i, jj).value
|
||
|
||
Dim rowNum As Long
|
||
rowNum = Worksheets(shMSSattach).Cells(i, jj + 1).value
|
||
|
||
If res("Response")("Data")(1)(hashName).Exists(colName) = True Then
|
||
Dim k As Long
|
||
For k = 1 To res("Response")("Data")(1)(hashName)(colName).count
|
||
Dim l As Long
|
||
l = (k - 1) * 2
|
||
''Debug.Print res("Response")("Data")(1)(hashName)(colName)(k)("Guid")
|
||
''Debug.Print res("Response")("Data")(1)(hashName)(colName)(k)("Name")
|
||
Worksheets(shMSSattach).Cells(k + 3, rowNum) = res("Response")("Data")(1)(hashName)(colName)(k)("Guid")
|
||
Worksheets(shMSSattach).Cells(k + 3, rowNum + 1) = res("Response")("Data")(1)(hashName)(colName)(k)("Name")
|
||
Next k
|
||
|
||
End If
|
||
Next i
|
||
|
||
|
||
'******************************************************************************
|
||
'お客様データのGuid保管エリアのクリア
|
||
'事前にセルをクリア
|
||
Worksheets(shMSSlist3).Range("L4:ZZ100").ClearContents
|
||
|
||
'ダウンロードログ欄のクリア
|
||
'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
|
||
|
||
'お客様データファイルの取得
|
||
Call getMSSfilesList
|
||
'その他データの取得
|
||
Call getOtherData
|
||
|
||
Call jsonToSheetTest
|
||
|
||
End Function
|
||
|