130 lines
3.8 KiB
QBasic
130 lines
3.8 KiB
QBasic
Attribute VB_Name = "Module5"
|
||
Option Explicit
|
||
'##########################################################################################################
|
||
' getMSSfilesList
|
||
' お客様データファイルのリストダウンロード
|
||
' getMSSfilesListRequest
|
||
' お客様データファイルの一覧取得リクエスト
|
||
' exportFileList
|
||
' 取得したファイル情報をシートに保存
|
||
|
||
|
||
'******************************************************************************
|
||
'お客様データの一覧を取得
|
||
Sub getMSSfilesList()
|
||
Application.ScreenUpdating = False '画面更新停止
|
||
Application.Calculation = xlManual '自動計算停止
|
||
|
||
Call init
|
||
'Debug.Print ">>> お客様データファイルのリストダウンロード 開始"
|
||
|
||
'//
|
||
Dim recordId As String
|
||
recordId = Range("お客様データID").value
|
||
If recordId <> "" And recordId <> "212512" Then
|
||
Call getMSSfilesListRequest(recordId)
|
||
End If
|
||
|
||
Application.Calculation = xlAutomatic '自動計算開始
|
||
Application.ScreenUpdating = True '画面更新開始
|
||
'Debug.Print "<<< お客様データファイルのリストダウンロード 終了"
|
||
|
||
End Sub
|
||
|
||
'******************************************************************************
|
||
'お客様データの一覧を取得リクエスト送信
|
||
Function getMSSfilesListRequest(ByVal recordId As String)
|
||
|
||
'共通変数
|
||
Dim apiUrl As String
|
||
Dim apiUrlParam As String
|
||
Dim tableId As String
|
||
|
||
'リクエストURL
|
||
apiUrl = baseURL & "/pleasanter/api/items/" & recordId & "/"
|
||
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 And res("Response")("TotalCount") = 1 Then
|
||
'正常に取得できたらシートへ書き込み
|
||
'Debug.Print "お客様データ 取得成功"
|
||
Call exportFileList(res)
|
||
End If
|
||
|
||
End Function
|
||
|
||
Function exportFileList(res)
|
||
'事前にセルをクリア
|
||
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
|
||
|
||
Dim i As Long
|
||
Dim colNum As Long
|
||
|
||
Dim hashName As String
|
||
Dim colLabel As String
|
||
Dim colName As String
|
||
|
||
Dim lastRow As Long
|
||
lastRow = Worksheets(shMSSlist3).Cells(Rows.count, 3).End(xlUp).Row
|
||
|
||
hashName = "AttachmentsHash"
|
||
|
||
For i = 4 To lastRow
|
||
colLabel = Worksheets(shMSSlist3).Cells(i, 2).value
|
||
colName = Worksheets(shMSSlist3).Cells(i, 3).value
|
||
colNum = Worksheets(shMSSlist3).Cells(i, 4).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
|
||
|
||
'添付ファイルリスト
|
||
Worksheets(shMSSlist3).Cells(k + 3, colNum) = res("Response")("Data")(1)(hashName)(colName)(k)("Guid")
|
||
Worksheets(shMSSlist3).Cells(k + 3, colNum + 1) = res("Response")("Data")(1)(hashName)(colName)(k)("Name")
|
||
Next k
|
||
|
||
End If
|
||
Next i
|
||
|
||
|
||
End Function
|
||
|