293 lines
9.1 KiB
QBasic
293 lines
9.1 KiB
QBasic
Attribute VB_Name = "Module8"
|
|
Option Explicit
|
|
|
|
'リストから契約コードを選択する
|
|
Sub getTsuihenFiles()
|
|
'Application.ScreenUpdating = False '画面更新停止
|
|
Application.Calculation = xlManual '自動計算停止
|
|
|
|
Call init
|
|
'Debug.Print ">>> 選択した追加変更申請の関連データをダウンロードする"
|
|
|
|
Dim Ad As String 'セル番号用変数
|
|
Dim Col As Integer 'セルの列番号用変数
|
|
Dim Row As Integer 'セルの行番号用変数
|
|
|
|
Dim sh As Worksheet
|
|
Set sh = Worksheets(thList)
|
|
|
|
Ad = ActiveCell.Address
|
|
Col = ActiveCell.Column
|
|
Row = ActiveCell.Row
|
|
|
|
|
|
'テーブル範囲無いにカーソルがあるときにボタンを押したら、契約コードを取得する
|
|
If Row >= 3 And Row <= 104 And Col >= 4 And Col <= 19 Then
|
|
Dim recoreId As Variant
|
|
recoreId = sh.Cells(Row, 5).value
|
|
|
|
'Debug.Print recoreId
|
|
|
|
If recoreId <> 0 Then
|
|
Range("WF追変申請ID").value = recoreId
|
|
|
|
'リスト消去
|
|
With sh.Range("B11")
|
|
.ClearContents
|
|
.Hyperlinks.Delete
|
|
.Font.Color = RGB(0, 0, 0)
|
|
.Font.Underline = False
|
|
.Font.Bold = False
|
|
End With
|
|
|
|
With sh.Range("B14:B113")
|
|
.ClearContents
|
|
.Hyperlinks.Delete
|
|
.Font.Color = RGB(0, 0, 0)
|
|
.Font.Underline = False
|
|
.Font.Bold = False
|
|
End With
|
|
|
|
Call getTsuihenFilesRequest(recoreId)
|
|
|
|
Else
|
|
Range("WF追変申請ID").value = ""
|
|
'リスト消去
|
|
With sh.Range("B11")
|
|
.ClearContents
|
|
.Hyperlinks.Delete
|
|
.Font.Color = RGB(0, 0, 0)
|
|
.Font.Underline = False
|
|
.Font.Bold = False
|
|
End With
|
|
|
|
With sh.Range("B14:B113")
|
|
.ClearContents
|
|
.Hyperlinks.Delete
|
|
.Font.Color = RGB(0, 0, 0)
|
|
.Font.Underline = False
|
|
.Font.Bold = False
|
|
End With
|
|
|
|
MsgBox "取得したいレコードを選択してください"
|
|
End If
|
|
Else
|
|
Range("WF追変申請ID").value = ""
|
|
MsgBox "取得したいレコードを選択してください"
|
|
End If
|
|
|
|
Application.Calculation = xlAutomatic '自動計算開始
|
|
'Application.ScreenUpdating = True '画面更新開始
|
|
'Debug.Print "<<< 選択した追加変更申請の関連データをダウンロードを終了しました"
|
|
|
|
End Sub
|
|
|
|
Function getTsuihenFilesRequest(targetId)
|
|
'共通変数
|
|
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
|
|
|
|
'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 res("Response")("TotalCount")
|
|
'正常に取得できたらシートへ書き込み
|
|
'Debug.Print "<<< 追加変更データ取得成功"
|
|
Call exporTsuihenFiles(res)
|
|
End If
|
|
|
|
|
|
End Function
|
|
|
|
Function exporTsuihenFiles(res)
|
|
Dim sh As Worksheet
|
|
Set sh = Worksheets(thList)
|
|
|
|
Dim hyplink As Hyperlink
|
|
|
|
Dim tsuihenFolder As String
|
|
'追加変更データ保存フォルダ名
|
|
tsuihenFolder = res("Response")("Data")(1)("ClassHash")("ClassM")
|
|
|
|
'Debug.Print currentDirPath & "\" & tsuihenFolder
|
|
|
|
'顧客別フォルダが存在するか確認
|
|
Dim fso As Object
|
|
Set fso = CreateObject("Scripting.FileSystemObject")
|
|
|
|
'追加変更保存フォルダ
|
|
If Not fso.FolderExists(currentDirPath & "\" & tsuihenFolder) Then
|
|
'ない場合はフォルダを作成
|
|
fso.CreateFolder (currentDirPath & "\" & tsuihenFolder)
|
|
End If
|
|
|
|
Dim file
|
|
Dim saveFolderPath As String
|
|
Dim guid As String
|
|
Dim name As String
|
|
Dim result As Boolean
|
|
|
|
Dim xx As Long
|
|
xx = 14
|
|
sh.Cells(xx, 2).value = "---ダウンロード開始---"
|
|
xx = xx + 1
|
|
|
|
sh.Cells(11, 2).value = tsuihenFolder
|
|
Set hyplink = sh.Hyperlinks.Add( _
|
|
Anchor:=sh.Cells(11, 2), _
|
|
Address:=tsuihenFolder)
|
|
|
|
For Each file In res("Response")("Data")(1)("AttachmentsHash")("AttachmentsA")
|
|
saveFolderPath = currentDirPath & "\" & tsuihenFolder & "\" & "契約書原本"
|
|
If Not fso.FolderExists(saveFolderPath) Then
|
|
'ない場合はフォルダを作成
|
|
fso.CreateFolder (saveFolderPath)
|
|
End If
|
|
guid = file("Guid")
|
|
name = file("Name")
|
|
'ダウンロード処理
|
|
result = getAttachmentsFile(guid, saveFolderPath)
|
|
|
|
'ダウンロード履歴保存
|
|
If result = True Then
|
|
sh.Cells(xx, 2).value = "契約書原本" & "\" & name
|
|
Set hyplink = sh.Hyperlinks.Add( _
|
|
Anchor:=sh.Cells(xx, 2), _
|
|
Address:=tsuihenFolder & "\" & "契約書原本" & "\" & name)
|
|
|
|
xx = xx + 1
|
|
End If
|
|
|
|
Next file
|
|
|
|
For Each file In res("Response")("Data")(1)("AttachmentsHash")("AttachmentsB")
|
|
saveFolderPath = currentDirPath & "\" & tsuihenFolder & "\" & "金額根拠資料①"
|
|
If Not fso.FolderExists(saveFolderPath) Then
|
|
'ない場合はフォルダを作成
|
|
fso.CreateFolder (saveFolderPath)
|
|
End If
|
|
guid = file("Guid")
|
|
name = file("Name")
|
|
'ダウンロード処理
|
|
result = getAttachmentsFile(guid, saveFolderPath)
|
|
|
|
'ダウンロード履歴保存
|
|
If result = True Then
|
|
sh.Cells(xx, 2).value = "金額根拠資料①" & "\" & name
|
|
Set hyplink = sh.Hyperlinks.Add( _
|
|
Anchor:=sh.Cells(xx, 2), _
|
|
Address:=tsuihenFolder & "\" & "金額根拠資料①" & "\" & name)
|
|
|
|
xx = xx + 1
|
|
End If
|
|
Next file
|
|
|
|
For Each file In res("Response")("Data")(1)("AttachmentsHash")("AttachmentsC")
|
|
saveFolderPath = currentDirPath & "\" & tsuihenFolder & "\" & "金額根拠資料②"
|
|
If Not fso.FolderExists(saveFolderPath) Then
|
|
'ない場合はフォルダを作成
|
|
fso.CreateFolder (saveFolderPath)
|
|
End If
|
|
guid = file("Guid")
|
|
name = file("Name")
|
|
'ダウンロード処理
|
|
result = getAttachmentsFile(guid, saveFolderPath)
|
|
'ダウンロード履歴保存
|
|
If result = True Then
|
|
sh.Cells(xx, 2).value = "金額根拠資料②" & "\" & name
|
|
Set hyplink = sh.Hyperlinks.Add( _
|
|
Anchor:=sh.Cells(xx, 2), _
|
|
Address:=tsuihenFolder & "\" & "金額根拠資料②" & "\" & name)
|
|
|
|
xx = xx + 1
|
|
End If
|
|
Next file
|
|
|
|
For Each file In res("Response")("Data")(1)("AttachmentsHash")("AttachmentsD")
|
|
saveFolderPath = currentDirPath & "\" & tsuihenFolder & "\" & "金額根拠資料③"
|
|
If Not fso.FolderExists(saveFolderPath) Then
|
|
'ない場合はフォルダを作成
|
|
fso.CreateFolder (saveFolderPath)
|
|
End If
|
|
guid = file("Guid")
|
|
name = file("Name")
|
|
'ダウンロード処理
|
|
result = getAttachmentsFile(guid, saveFolderPath)
|
|
If result = True Then
|
|
sh.Cells(xx, 2).value = "金額根拠資料③" & "\" & name
|
|
Set hyplink = sh.Hyperlinks.Add( _
|
|
Anchor:=sh.Cells(xx, 2), _
|
|
Address:=tsuihenFolder & "\" & "金額根拠資料③" & "\" & name)
|
|
|
|
xx = xx + 1
|
|
End If
|
|
Next file
|
|
|
|
For Each file In res("Response")("Data")(1)("AttachmentsHash")("AttachmentsE")
|
|
saveFolderPath = currentDirPath & "\" & tsuihenFolder & "\" & "金額根拠資料④"
|
|
If Not fso.FolderExists(saveFolderPath) Then
|
|
'ない場合はフォルダを作成
|
|
fso.CreateFolder (saveFolderPath)
|
|
End If
|
|
guid = file("Guid")
|
|
name = file("Name")
|
|
'ダウンロード処理
|
|
result = getAttachmentsFile(guid, saveFolderPath)
|
|
If result = True Then
|
|
sh.Cells(xx, 2).value = "金額根拠資料④" & "\" & name
|
|
Set hyplink = sh.Hyperlinks.Add( _
|
|
Anchor:=sh.Cells(xx, 2), _
|
|
Address:=tsuihenFolder & "\" & "金額根拠資料④" & "\" & name)
|
|
|
|
xx = xx + 1
|
|
End If
|
|
Next file
|
|
|
|
For Each file In res("Response")("Data")(1)("AttachmentsHash")("AttachmentsF")
|
|
saveFolderPath = currentDirPath & "\" & tsuihenFolder & "\" & "金額根拠資料⑤"
|
|
If Not fso.FolderExists(saveFolderPath) Then
|
|
'ない場合はフォルダを作成
|
|
fso.CreateFolder (saveFolderPath)
|
|
End If
|
|
guid = file("Guid")
|
|
name = file("Name")
|
|
'ダウンロード処理
|
|
result = getAttachmentsFile(guid, saveFolderPath)
|
|
If result = True Then
|
|
sh.Cells(xx, 2).value = "金額根拠資料⑤" & "\" & name
|
|
Set hyplink = sh.Hyperlinks.Add( _
|
|
Anchor:=sh.Cells(xx, 2), _
|
|
Address:=tsuihenFolder & "\" & "金額根拠資料⑤" & "\" & name)
|
|
|
|
xx = xx + 1
|
|
End If
|
|
Next file
|
|
|
|
sh.Cells(xx, 2).value = "---ダウンロード終了---"
|
|
|
|
End Function
|