From 243ecb1b4b9826c23ee5d7e56ad295d201b08e09 Mon Sep 17 00:00:00 2001
From: Kenichiro NOGI <systemadmin@next-hd.co.jp>
Date: Fri, 11 Sep 2026 13:50:06 +0900
Subject: [PATCH] =?UTF-8?q?fix:=20run()=E3=81=AE=E3=82=A8=E3=83=A9?=
 =?UTF-8?q?=E3=83=BC=E3=83=8F=E3=83=B3=E3=83=89=E3=83=AA=E3=83=B3=E3=82=B0?=
 =?UTF-8?q?=E3=83=BB=E5=A4=B1=E6=95=97=E6=A4=9C=E7=9F=A5=E3=81=A8Get?=
 =?UTF-8?q?=E2=86=92Export=E5=88=87=E6=9B=BF=E6=99=82=E3=81=AE=E3=83=98?=
 =?UTF-8?q?=E3=83=83=E3=83=80=E6=AE=8B=E7=95=99=E3=83=BB=E9=85=8D=E5=88=97?=
 =?UTF-8?q?=E5=80=A4=E3=82=AF=E3=83=A9=E3=83=83=E3=82=B7=E3=83=A5=E3=82=92?=
 =?UTF-8?q?=E4=BF=AE=E6=AD=A3?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

最終レビューで指摘されたImportant4件に対応:
- run()にエラーハンドラを追加し、失敗時もCalculation/ScreenUpdatingを確実に復元
- runExportFlow/runGetFlowをBoolean化し、データ取得失敗をD3に反映
- Get方式実行後のExport方式実行でヘッダが残留する問題を、既存テーブル削除で解消
- getRecordsDataToSheetでオブジェクト値（JSON配列等）による実行時エラーを回避
---
 .../vba-files/Module/Module1.bas              | 45 +++++++++++++++----
 1 file changed, 37 insertions(+), 8 deletions(-)

diff --git a/XVBA/新版着工要因閲覧シート/vba-files/Module/Module1.bas b/XVBA/新版着工要因閲覧シート/vba-files/Module/Module1.bas
index b7c06899..cf648223 100644
--- a/XVBA/新版着工要因閲覧シート/vba-files/Module/Module1.bas
+++ b/XVBA/新版着工要因閲覧シート/vba-files/Module/Module1.bas
@@ -23,6 +23,8 @@ Sub run()
     '����������
     Call init
 
+    On Error GoTo Cleanup
+
     defaultSh.Range("D4").Value = Now
     defaultSh.Range("D3").Value = "�捞������..."
     Application.ScreenUpdating = False '��ʍX�V��~
@@ -30,25 +32,37 @@ Sub run()
     '------------------------------------------
     Debug.Print "�����J�n"
 
+    Dim success As Boolean
     Select Case fetchMethod
         Case "Get"
-            Call runGetFlow
+            success = runGetFlow()
         Case Else
-            Call runExportFlow
+            success = runExportFlow()
     End Select
 
     Debug.Print "�����I��"
     '------------------------------------------
+
+Cleanup:
     Application.Calculation = xlAutomatic '�����v�Z�ĊJ
     Application.ScreenUpdating = True '��ʍX�V�ĊJ
     defaultSh.Range("D5").Value = Now
     defaultSh.Range("D6").Value = (defaultSh.Range("D5").Value - defaultSh.Range("D4").Value) * 86400
-    defaultSh.Range("D3").Value = "�捞��������"
+
+    If Err.Number <> 0 Then
+        defaultSh.Range("D3").Value = "�捞�������s�i�G���[�j: " & Err.Description
+        Err.Clear
+    ElseIf Not success Then
+        defaultSh.Range("D3").Value = "�捞�������s�i�f�[�^�擾�G���[�j"
+    Else
+        defaultSh.Range("D3").Value = "�捞��������"
+    End If
 End Sub
 
 '******************************************************************************
 'Export�����iCSV�S���擾�j�ł̃f�[�^�捞����
-Sub runExportFlow()
+'������True�A�f�[�^���擾�ł��Ȃ������ꍇFalse��Ԃ�
+Function runExportFlow() As Boolean
     Dim resData As Variant
 
     Debug.Print "�f�[�^�擾�����J�n�iExport�����j"
@@ -56,14 +70,22 @@ Sub runExportFlow()
 
     If IsEmpty(resData) Or resData = "" Then
         Debug.Print "�f�[�^���擾�ł��܂���ł���"
+        runExportFlow = False
     Else
+        'Get�������s���̃w�b�_��\�����c���Ă���ꍇ�ɔ����A�����e�[�u�����폜���Ă����蒼��
+        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�����iapi-record-get-multi�j�ł̃f�[�^�捞����
-Sub runGetFlow()
+'������True�A�f�[�^���擾�ł��Ȃ������ꍇFalse��Ԃ�
+Function runGetFlow() As Boolean
     Dim records As Collection
 
     Debug.Print "�f�[�^�擾�����J�n�iGet�����j"
@@ -71,12 +93,15 @@ Sub runGetFlow()
 
     If records Is Nothing Then
         Debug.Print "�f�[�^���擾�ł��܂���ł���"
+        runGetFlow = False
     ElseIf records.count = 0 Then
         Debug.Print "�f�[�^���擾�ł��܂���ł���"
+        runGetFlow = False
     Else
         Call getRecordsDataToSheet(records, tableId)
+        runGetFlow = True
     End If
-End Sub
+End Function
 
 '******************************************************************************
 'CSV�f�[�^���擾
@@ -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
-            dataArr(i, j) = curRec(headerKeys(j - 1))
+            If IsObject(curRec(headerKeys(j - 1))) Then
+                dataArr(i, j) = ""
+            Else
+                dataArr(i, j) = curRec(headerKeys(j - 1))
+            End If
         Next j
     Next i