fix: Export/Get方式とも0件取得時にテーブルのデータ部分をクリアするよう修正
従来は0件時にMsgBoxを出して即終了し、テーブルの前回データがそのまま残ってしまっていた。 runGetFlowはrecords.count=0でもgetRecordsDataToSheetを呼ぶよう変更し、getRecordsDataToSheet/exportCSVDataToSheetは0件時にMsgBoxを出さずヘッダを維持したままDataBodyRangeだけクリアするよう修正。 Co-Authored-By: Claude Sonnet 5 <noreply@anthropic.com>
This commit is contained in:
parent
06340cdb7b
commit
67b9f8c0f8
@ -106,9 +106,6 @@ Function runGetFlow() As Boolean
|
||||
If records Is Nothing Then
|
||||
Debug.Print "データが取得できませんでした"
|
||||
runGetFlow = False
|
||||
ElseIf records.count = 0 Then
|
||||
Debug.Print "データが取得できませんでした"
|
||||
runGetFlow = False
|
||||
Else
|
||||
Call getRecordsDataToSheet(records, tableId & "G")
|
||||
t2 = Timer
|
||||
@ -180,8 +177,17 @@ Function exportCSVDataToSheet(csvData As Variant, targetSheet As String)
|
||||
Set rows = ParseCsv(csvData)
|
||||
|
||||
If rows.count <= 1 Then
|
||||
MsgBox "データが存在しません(ヘッダのみ): " & targetSheet, vbExclamation
|
||||
Exit Function
|
||||
Debug.Print "データが0件のため、既存テーブルのデータ部分をクリアします: " & targetSheet
|
||||
Dim tblEmpty As ListObject
|
||||
On Error Resume Next
|
||||
Set tblEmpty = ws.ListObjects(targetSheet)
|
||||
On Error GoTo 0
|
||||
If Not tblEmpty Is Nothing Then
|
||||
If Not tblEmpty.DataBodyRange Is Nothing Then
|
||||
tblEmpty.DataBodyRange.ClearContents
|
||||
End If
|
||||
End If
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
maxCols = 0
|
||||
@ -448,11 +454,6 @@ End Function
|
||||
Function getRecordsDataToSheet(records As Collection, targetSheet As String)
|
||||
Debug.Print "レコードをシートに出力開始: " & targetSheet
|
||||
|
||||
If records.count = 0 Then
|
||||
MsgBox "データが存在しません: " & targetSheet, vbExclamation
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
Dim ws As Worksheet
|
||||
On Error Resume Next
|
||||
Set ws = ThisWorkbook.Sheets(targetSheet)
|
||||
@ -464,6 +465,20 @@ Function getRecordsDataToSheet(records As Collection, targetSheet As String)
|
||||
ws.Name = targetSheet
|
||||
End If
|
||||
|
||||
If records.count = 0 Then
|
||||
Debug.Print "データが0件のため、既存テーブルのデータ部分をクリアします: " & targetSheet
|
||||
Dim tblEmpty As ListObject
|
||||
On Error Resume Next
|
||||
Set tblEmpty = ws.ListObjects(targetSheet)
|
||||
On Error GoTo 0
|
||||
If Not tblEmpty Is Nothing Then
|
||||
If Not tblEmpty.DataBodyRange Is Nothing Then
|
||||
tblEmpty.DataBodyRange.ClearContents
|
||||
End If
|
||||
End If
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
Dim flatRecords As New Collection
|
||||
Dim rec As Dictionary
|
||||
For Each rec In records
|
||||
|
||||
Loading…
Reference in New Issue
Block a user