fix: run()のエラーハンドリング・失敗検知とGet→Export切替時のヘッダ残留・配列値クラッシュを修正

最終レビューで指摘されたImportant4件に対応:
- run()にエラーハンドラを追加し、失敗時もCalculation/ScreenUpdatingを確実に復元
- runExportFlow/runGetFlowをBoolean化し、データ取得失敗をD3に反映
- Get方式実行後のExport方式実行でヘッダが残留する問題を、既存テーブル削除で解消
- getRecordsDataToSheetでオブジェクト値(JSON配列等)による実行時エラーを回避
This commit is contained in:
Kenichiro NOGI 2026-09-11 13:50:06 +09:00
parent fabee98ea1
commit 243ecb1b4b

View File

@ -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