fix: run()のエラーハンドリング・失敗検知とGet→Export切替時のヘッダ残留・配列値クラッシュを修正
最終レビューで指摘されたImportant4件に対応: - run()にエラーハンドラを追加し、失敗時もCalculation/ScreenUpdatingを確実に復元 - runExportFlow/runGetFlowをBoolean化し、データ取得失敗をD3に反映 - Get方式実行後のExport方式実行でヘッダが残留する問題を、既存テーブル削除で解消 - getRecordsDataToSheetでオブジェクト値(JSON配列等)による実行時エラーを回避
This commit is contained in:
parent
fabee98ea1
commit
243ecb1b4b
@ -23,6 +23,8 @@ Sub run()
|
||||
'初期化処理
|
||||
Call init
|
||||
|
||||
On Error GoTo Cleanup
|
||||
|
||||
defaultSh.Range("D4").Value = Now
|
||||
defaultSh.Range("D3").Value = "取込処理中..."
|
||||
Application.ScreenUpdating = False '画面更新停止
|
||||
@ -30,25 +32,37 @@ Sub run()
|
||||
'------------------------------------------
|
||||
Debug.Print "処理開始"
|
||||
|
||||
Dim success As Boolean
|
||||
Select Case fetchMethod
|
||||
Case "Get"
|
||||
Call runGetFlow
|
||||
success = runGetFlow()
|
||||
Case Else
|
||||
Call runExportFlow
|
||||
success = runExportFlow()
|
||||
End Select
|
||||
|
||||
Debug.Print "処理終了"
|
||||
'------------------------------------------
|
||||
|
||||
Cleanup:
|
||||
Application.Calculation = xlAutomatic '自動計算再開
|
||||
Application.ScreenUpdating = True '画面更新再開
|
||||
defaultSh.Range("D5").Value = Now
|
||||
defaultSh.Range("D6").Value = (defaultSh.Range("D5").Value - defaultSh.Range("D4").Value) * 86400
|
||||
|
||||
If Err.Number <> 0 Then
|
||||
defaultSh.Range("D3").Value = "取込処理失敗(エラー): " & Err.Description
|
||||
Err.Clear
|
||||
ElseIf Not success Then
|
||||
defaultSh.Range("D3").Value = "取込処理失敗(データ取得エラー)"
|
||||
Else
|
||||
defaultSh.Range("D3").Value = "取込処理完了"
|
||||
End If
|
||||
End Sub
|
||||
|
||||
'******************************************************************************
|
||||
'Export方式(CSV全件取得)でのデータ取込処理
|
||||
Sub runExportFlow()
|
||||
'成功時True、データを取得できなかった場合Falseを返す
|
||||
Function runExportFlow() As Boolean
|
||||
Dim resData As Variant
|
||||
|
||||
Debug.Print "データ取得処理開始(Export方式)"
|
||||
@ -56,14 +70,22 @@ Sub runExportFlow()
|
||||
|
||||
If IsEmpty(resData) Or resData = "" Then
|
||||
Debug.Print "データが取得できませんでした"
|
||||
runExportFlow = False
|
||||
Else
|
||||
'Get方式実行時のヘッダ列構成が残っている場合に備え、既存テーブルを削除してから作り直す
|
||||
On Error Resume Next
|
||||
ThisWorkbook.Sheets(tableId).ListObjects(tableId).Delete
|
||||
On Error GoTo 0
|
||||
|
||||
Call exportCSVDataToSheet(resData, tableId)
|
||||
runExportFlow = True
|
||||
End If
|
||||
End Sub
|
||||
End Function
|
||||
|
||||
'******************************************************************************
|
||||
'Get方式(api-record-get-multi)でのデータ取込処理
|
||||
Sub runGetFlow()
|
||||
'成功時True、データを取得できなかった場合Falseを返す
|
||||
Function runGetFlow() As Boolean
|
||||
Dim records As Collection
|
||||
|
||||
Debug.Print "データ取得処理開始(Get方式)"
|
||||
@ -71,12 +93,15 @@ Sub runGetFlow()
|
||||
|
||||
If records Is Nothing Then
|
||||
Debug.Print "データが取得できませんでした"
|
||||
runGetFlow = False
|
||||
ElseIf records.count = 0 Then
|
||||
Debug.Print "データが取得できませんでした"
|
||||
runGetFlow = False
|
||||
Else
|
||||
Call getRecordsDataToSheet(records, tableId)
|
||||
runGetFlow = True
|
||||
End If
|
||||
End Sub
|
||||
End Function
|
||||
|
||||
'******************************************************************************
|
||||
'CSVデータを取得
|
||||
@ -410,7 +435,11 @@ Function getRecordsDataToSheet(records As Collection, targetSheet As String)
|
||||
Dim curRec As Dictionary
|
||||
Set curRec = flatRecords(i)
|
||||
For j = 1 To maxCols
|
||||
If IsObject(curRec(headerKeys(j - 1))) Then
|
||||
dataArr(i, j) = ""
|
||||
Else
|
||||
dataArr(i, j) = curRec(headerKeys(j - 1))
|
||||
End If
|
||||
Next j
|
||||
Next i
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user