Attribute VB_Name = "Module1"
Option Explicit

Public apiKey As String
Public baseURL As String
Public yearFilter As String
Public tableId As String
Public defaultSh As Worksheet

Function init()
    'Pleasanter API KEY
    apiKey = "6504c8a807677a3a576e10327f3c19876c55736ee45d4a845796b9e7f5e087bfd4bd0d8184863da8cf1733ca635111432ab334aea59102b06a96ee6d2c05190d"
    baseURL = "https://nextoffice.Next-hd.co.jp"
    tableId = Range("着工要因ID")

    Set defaultSh = ThisWorkbook.Sheets("基本情報")
End Function

'******************************************************************************
Sub run()
    '初期化処理
    Call init

    '入力チェック（営業所・物件状況が未選択なら処理中断）
    Dim selSalesOffice As Variant, selPropertyStatus As Variant
    selSalesOffice = Range("選択営業所").Cells(1, 1).Value
    selPropertyStatus = Range("選択状況").Cells(1, 1).Value
    If IsError(selSalesOffice) Then selSalesOffice = ""
    If IsError(selPropertyStatus) Then selPropertyStatus = ""

    If Trim(CStr(selSalesOffice)) = "" Or Trim(CStr(selPropertyStatus)) = "" Then
        MsgBox "営業所と物件状況は必ず選択してください", vbExclamation
        Exit Sub
    End If

    On Error GoTo Cleanup

    defaultSh.Range("D4").Value = Now
    defaultSh.Range("D3").Value = "取込処理中..."
    Debug.Print "[D3] " & defaultSh.Range("D3").Value
    Application.ScreenUpdating = False '画面更新停止
    Application.Calculation = xlManual '自動計算停止
    '------------------------------------------
    Debug.Print "処理開始"

    Dim exportSuccess As Boolean
    Dim getSuccess As Boolean
    exportSuccess = runExportFlow()
    getSuccess = runGetFlow()

    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
        Debug.Print "[D3] " & defaultSh.Range("D3").Value
        Err.Clear
    ElseIf Not (exportSuccess And getSuccess) Then
        defaultSh.Range("D3").Value = "取込処理失敗（データ取得エラー）"
        Debug.Print "[D3] " & defaultSh.Range("D3").Value
    Else
        defaultSh.Range("D3").Value = "取込処理完了"
        Debug.Print "[D3] " & defaultSh.Range("D3").Value
    End If
End Sub

'******************************************************************************
'Export方式（CSV全件取得）でのデータ取込処理
'成功時True、データを取得できなかった場合Falseを返す
Function runExportFlow() As Boolean
    Dim resData As Variant
    Dim t0 As Double, t1 As Double, t2 As Double

    Debug.Print "データ取得処理開始（Export方式）"
    t0 = Timer
    'Filter・Sorter条件（基本情報シートのFilterTable・SorterTableから組み立てる、Get方式と同条件）
    Dim viewObj As Object
    Set viewObj = BuildViewFromSheet()
    resData = exportCSVData(tableId, viewObj)
    t1 = Timer
    Debug.Print "  exportCSVData(API通信) 所要時間: " & Format(t1 - t0, "0.000") & "秒"

    If IsEmpty(resData) Or resData = "" Then
        Debug.Print "データが取得できませんでした"
        runExportFlow = False
    Else
        Call exportCSVDataToSheet(resData, tableId & "E")
        t2 = Timer
        Debug.Print "  exportCSVDataToSheet(パース+書込) 所要時間: " & Format(t2 - t1, "0.000") & "秒"
        runExportFlow = True
    End If
End Function

'******************************************************************************
'Get方式（api-record-get-multi）でのデータ取込処理
'成功時True、データを取得できなかった場合Falseを返す
Function runGetFlow() As Boolean
    Dim records As Collection
    Dim t0 As Double, t1 As Double, t2 As Double

    Debug.Print "データ取得処理開始（Get方式）"
    t0 = Timer
    Set records = getRecordsData(tableId)
    t1 = Timer
    Debug.Print "  getRecordsData(API通信) 所要時間: " & Format(t1 - t0, "0.000") & "秒"

    If records Is Nothing Then
        Debug.Print "データが取得できませんでした"
        runGetFlow = False
    Else
        Call getRecordsDataToSheet(records, tableId & "G")
        t2 = Timer
        Debug.Print "  getRecordsDataToSheet(書込) 所要時間: " & Format(t2 - t1, "0.000") & "秒"
        runGetFlow = True
    End If
End Function

'******************************************************************************
'CSVデータを取得
Function exportCSVData(tableId As String, Optional viewObj As Object = Nothing) As Variant
    '共通変数
    Dim apiUrl As String
    Dim apiUrlParam As String

    'リクエストURL
    apiUrl = baseURL & "/pleasanter/api/items/" & tableId & "/"
    apiUrlParam = "export"

    'ヘッダ
    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
    apiBody.Add "ExportId", "1"

    If Not viewObj Is Nothing Then
        apiBody.Add "View", viewObj
    End If

    'HTTPリクエスト送信メソッド呼び出し
    Dim res As Object
    Set res = callRestApi("POST", apiUrl, apiUrlParam, apiHeaders, apiBody)

    If res("StatusCode") = 200 Then
        Debug.Print "CSVデータの取得に成功しました"
        exportCSVData = res("Response")("Content")

    End If

End Function

'******************************************************************************
'CSVデータをシートに書き込む
Function exportCSVDataToSheet(csvData As Variant, targetSheet As String)
    Debug.Print "CSVデータをシートに出力開始: " & targetSheet
    '------------------------------------------
    'CSVデータを「テーブル」部分に出力する処理
    Dim ws As Worksheet
    On Error Resume Next
    Set ws = ThisWorkbook.Sheets(targetSheet)
    On Error Goto 0

        If ws Is Nothing Then
            Debug.Print "シートが存在しないため新規作成: " & targetSheet
            Set ws = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.count))
            ws.Name = targetSheet
        End If

        'CSVデータをテーブルに挿入（ダブルクォート内の改行・カンマに対応したCSVパース）
        Dim i As Long, j As Long
        Dim arr() As Variant
        Dim maxCols As Long

        Dim rows As Collection
        Set rows = ParseCsv(csvData)

        If rows.count <= 1 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 tblEmpty.Range.Rows.count > 1 Then
                    tblEmpty.Range.Resize(tblEmpty.Range.Rows.count - 1, tblEmpty.Range.Columns.count).Offset(1, 0).ClearContents
                End If
            End If
            Exit Function
        End If

        maxCols = 0
        Dim rowArr As Variant
        For Each rowArr In rows
            If UBound(rowArr) + 1 > maxCols Then
                maxCols = UBound(rowArr) + 1
            End If
        Next rowArr

        ' 二次元配列を初期化
        ReDim arr(0 To rows.count - 1, 0 To maxCols - 1)

        ' 配列に格納
        i = 0
        For Each rowArr In rows
            For j = LBound(rowArr) To UBound(rowArr)
                arr(i, j) = rowArr(j)
            Next j
            i = i + 1
        Next rowArr

        'テーブル（ListObject）取得
        Dim tbl As ListObject
        On Error Resume Next
        Set tbl = ws.ListObjects(targetSheet)
        On Error Goto 0

            'ヘッダ行はテーブルの有無に関わらず毎回CSVの1行目(arr(0,*))で更新する（列構成の変更に追従するため）
            Dim headerRange As Range
            Set headerRange = ws.Range("A1").Resize(1, maxCols)
            For j = 0 To maxCols - 1
                headerRange.Cells(1, j + 1).Value = arr(0, j)
            Next j

            If tbl Is Nothing Then
                Debug.Print "テーブルが存在しないため新規作成: " & targetSheet
                Set tbl = ws.ListObjects.Add(xlSrcRange, headerRange, , xlYes)
                tbl.Name = targetSheet
            End If

            '既存データ部分を毎回クリア（DataBodyRangeプロパティは内部状態が更新されず
            'Nothingのままになることがあるため使わず、テーブル範囲から直接計算する）
            If tbl.Range.Rows.count > 1 Then
                tbl.Range.Resize(tbl.Range.Rows.count - 1, tbl.Range.Columns.count).Offset(1, 0).ClearContents
            End If

            ' テーブルを目的のサイズにリサイズ
            tbl.Resize tbl.Range.Resize(rows.count, maxCols)

            Dim dataArr() As Variant
            ReDim dataArr(1 To rows.count - 1, 1 To maxCols)
            For i = 1 To rows.count - 1
                For j = 1 To maxCols
                    dataArr(i, j) = arr(i, j - 1)
                Next j
            Next i

            'データ書き込み（DataBodyRangeプロパティを使わず、ヘッダ行の次からテーブル範囲を直接計算する）
            Dim dataRange As Range
            Set dataRange = tbl.Range.Resize(rows.count - 1, maxCols).Offset(1, 0)
            dataRange.Value = dataArr

            '------------------------------------------
            Debug.Print "CSVデータをシートに出力完了: " & targetSheet

End Function

'******************************************************************************
'CSV文字列をパースし、行ごとのフィールド配列を格納したCollectionを返す
'ダブルクォートで囲まれたフィールド内の改行・カンマ・エスケープされた""に対応（RFC4180準拠）
Private Function ParseCsv(Byval csvText As String) As Collection
    Dim rows As New Collection
    Dim fields As Collection
    Set fields = New Collection

    Dim field As String
    Dim inQuotes As Boolean
    Dim i As Long, ch As String, nextCh As String
    Dim textLen As Long
    textLen = Len(csvText)
    inQuotes = False
    field = ""

    i = 1
    Do While i <= textLen
        ch = Mid(csvText, i, 1)

        If inQuotes Then
            If ch = """" Then
                nextCh = Mid(csvText, i + 1, 1)
                If nextCh = """" Then
                    field = field & """"
                    i = i + 1
                Else
                    inQuotes = False
                End If
            Else
                field = field & ch
            End If
        Else
            Select Case ch
             Case """"
                inQuotes = True
             Case ","
                fields.Add field
                field = ""
             Case vbCr, vbLf
                If ch = vbCr And Mid(csvText, i + 1, 1) = vbLf Then i = i + 1
                    fields.Add field
                    field = ""
                    If Not (fields.count = 1 And fields(1) = "") Then
                        rows.Add CollectionToArray(fields)
                    End If
                    Set fields = New Collection
                 Case Else
                    field = field & ch
                End Select
            End If
            i = i + 1
        Loop

        '最終フィールド・行（末尾に改行が無い場合）
        If field <> "" Or fields.count > 0 Then
            fields.Add field
            rows.Add CollectionToArray(fields)
        End If

        Set ParseCsv = rows
End Function

'Collection（1次元）を0始まりのVariant配列に変換
Private Function CollectionToArray(Byval col As Collection) As Variant
    Dim arr() As Variant
    ReDim arr(0 To col.count - 1)
    Dim k As Long
    For k = 1 To col.count
        arr(k - 1) = col(k)
    Next k
    CollectionToArray = arr
End Function

'******************************************************************************
'基本情報シート上の「FilterTable」「SorterTable」という名前のExcelテーブル（ListObject）を
'テーブル名で探して読み取り、APIリクエストのViewパラメータに渡すDictionaryを組み立てる。
'セルの絶対位置には依存しない（テーブルを移動しても動作する）。各テーブルは1列目=項目名、2列目=値/昇降順とする。
'Filter・Sorterともに0件の場合はNothingを返す（Viewパラメータ自体を付与しないため）
'ブック内の全シートを走査し、指定した名前のExcelテーブル(ListObject)を探す。見つからなければNothingを返す
Function FindListObjectByName(ByVal tblName As String) As ListObject
    Dim sh As Worksheet
    Dim tbl As ListObject
    For Each sh In ThisWorkbook.Worksheets
        On Error Resume Next
        Set tbl = sh.ListObjects(tblName)
        On Error GoTo 0
        If Not tbl Is Nothing Then
            Set FindListObjectByName = tbl
            Exit Function
        End If
    Next sh
    Set FindListObjectByName = Nothing
End Function

Function BuildViewFromSheet() As Object
    Dim colFilter As New Dictionary
    Dim filterTbl As ListObject
    Set filterTbl = FindListObjectByName("FilterTable")

    If Not filterTbl Is Nothing Then
        If Not filterTbl.DataBodyRange Is Nothing Then
            Dim r As Long
            For r = 1 To filterTbl.DataBodyRange.Rows.count
                Dim filterKey As String
                filterKey = Trim(filterTbl.DataBodyRange.Cells(r, 1).Value)
                If filterKey <> "" Then
                    colFilter.Add filterKey, "[" & Chr(34) & CStr(filterTbl.DataBodyRange.Cells(r, 2).Value) & Chr(34) & "]"
                End If
            Next r
        End If
    End If

    Dim colSorter As New Dictionary
    Dim sorterTbl As ListObject
    Set sorterTbl = FindListObjectByName("SorterTable")

    If Not sorterTbl Is Nothing Then
        If Not sorterTbl.DataBodyRange Is Nothing Then
            Dim r2 As Long
            For r2 = 1 To sorterTbl.DataBodyRange.Rows.count
                Dim sorterKey As String
                sorterKey = Trim(sorterTbl.DataBodyRange.Cells(r2, 1).Value)
                If sorterKey <> "" Then
                    colSorter.Add sorterKey, sorterTbl.DataBodyRange.Cells(r2, 2).Value
                End If
            Next r2
        End If
    End If

    If colFilter.count = 0 And colSorter.count = 0 Then
        Set BuildViewFromSheet = Nothing
        Exit Function
    End If

    Dim viewObj As New Dictionary
    If colFilter.count > 0 Then
        viewObj.Add "ColumnFilterHash", colFilter
    End If
    If colSorter.count > 0 Then
        viewObj.Add "ColumnSorterHash", colSorter
    End If

    Set BuildViewFromSheet = viewObj
End Function

'******************************************************************************
'Get方式（api-record-get-multi）でレコードを取得する
'成功時、レコードDictionaryのCollection(Response.Data)を返す
Function getRecordsData(tableId As String) As Collection
    Dim apiUrl As String
    Dim apiUrlParam As String

    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

    Dim viewObj As Object
    Set viewObj = BuildViewFromSheet()
    If Not viewObj Is Nothing Then
        apiBody.Add "View", viewObj
    End If

    Dim res As Object
    Set res = callRestApi("POST", apiUrl, apiUrlParam, apiHeaders, apiBody)

    If res("StatusCode") = 200 Then
        Debug.Print "レコードの取得に成功しました"
        Set getRecordsData = res("Response")("Data")
    End If
End Function

'******************************************************************************
'レコードDictionary内のネストした*Hash（ClassHash、NumHash、DateHash、DescriptionHash、CheckHashなど）を
'展開し、1階層のDictionaryにフラット化する
Function FlattenRecord(record As Dictionary) As Dictionary
    Dim flat As New Dictionary
    Dim key As Variant
    For Each key In record.Keys
        If TypeName(record(key)) = "Dictionary" Then
            Dim innerKey As Variant
            For Each innerKey In record(key).Keys
                flat.Add innerKey, record(key)(innerKey)
            Next innerKey
        Else
            flat.Add key, record(key)
        End If
    Next key
    Set FlattenRecord = flat
End Function

'******************************************************************************
'Get方式で取得したレコードをシートに書き込む（exportCSVDataToSheetとは独立実装）
'ヘッダはフラット化後の1件目レコードのキー一覧をそのまま使用する（内部キー名のまま、日本語ラベル変換はしない）
Function getRecordsDataToSheet(records As Collection, targetSheet As String)
    Debug.Print "レコードをシートに出力開始: " & targetSheet

    Dim ws As Worksheet
    On Error Resume Next
    Set ws = ThisWorkbook.Sheets(targetSheet)
    On Error GoTo 0

    If ws Is Nothing Then
        Debug.Print "シートが存在しないため新規作成: " & targetSheet
        Set ws = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.count))
        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 tblEmpty.Range.Rows.count > 1 Then
                tblEmpty.Range.Resize(tblEmpty.Range.Rows.count - 1, tblEmpty.Range.Columns.count).Offset(1, 0).ClearContents
            End If
        End If
        Exit Function
    End If

    Dim flatRecords As New Collection
    Dim rec As Dictionary
    For Each rec In records
        flatRecords.Add FlattenRecord(rec)
    Next rec

    Dim headerDict As Dictionary
    Set headerDict = flatRecords(1)
    Dim headerKeys As Variant
    headerKeys = headerDict.Keys
    Dim maxCols As Long
    maxCols = headerDict.count

    Dim i As Long, j As Long
    Dim dataArr() As Variant
    ReDim dataArr(1 To flatRecords.count, 1 To maxCols)
    For i = 1 To flatRecords.count
        Dim curRec As Dictionary
        Set curRec = flatRecords(i)
        For j = 1 To maxCols
            dataArr(i, j) = NormalizeGetValue(curRec(headerKeys(j - 1)))
        Next j
    Next i

    Dim tbl As ListObject
    On Error Resume Next
    Set tbl = ws.ListObjects(targetSheet)
    On Error GoTo 0

    Dim headerRange As Range
    Set headerRange = ws.Range("A1").Resize(1, maxCols)
    For j = 0 To maxCols - 1
        headerRange.Cells(1, j + 1).Value = headerKeys(j)
    Next j

    If tbl Is Nothing Then
        Debug.Print "テーブルが存在しないため新規作成: " & targetSheet
        Set tbl = ws.ListObjects.Add(xlSrcRange, headerRange, , xlYes)
        tbl.Name = targetSheet
    End If

    '既存データ部分を毎回クリア（DataBodyRangeプロパティは内部状態が更新されず
    'Nothingのままになることがあるため使わず、テーブル範囲から直接計算する）
    If tbl.Range.Rows.count > 1 Then
        tbl.Range.Resize(tbl.Range.Rows.count - 1, tbl.Range.Columns.count).Offset(1, 0).ClearContents
    End If

    ' テーブルを目的のサイズにリサイズ
    tbl.Resize tbl.Range.Resize(flatRecords.count + 1, maxCols)

    'データ書き込み（DataBodyRangeプロパティを使わず、ヘッダ行の次からテーブル範囲を直接計算する）
    Dim dataRange As Range
    Set dataRange = tbl.Range.Resize(flatRecords.count, maxCols).Offset(1, 0)
    dataRange.Value = dataArr

    Debug.Print "レコードのシート出力完了: " & targetSheet
End Function

'******************************************************************************
'Get方式で取得した値のうち、ISO8601形式の日付時刻文字列を正規化する
'YYYY-MM-DDThh:mm:ss形式 → "yyyy/mm/dd"、未設定を示す1899-12-30は空欄にする
'オブジェクト値（JSON配列等）は空欄にする
Function NormalizeGetValue(ByVal v As Variant) As Variant
    If IsObject(v) Then
        NormalizeGetValue = ""
        Exit Function
    End If

    Dim s As String
    s = CStr(v)
    If Len(s) >= 10 And Mid(s, 5, 1) = "-" And Mid(s, 8, 1) = "-" And Mid(s, 11, 1) = "T" Then
        If Left(s, 10) = "1899-12-30" Then
            NormalizeGetValue = ""
        Else
            NormalizeGetValue = Mid(s, 1, 4) & "/" & Mid(s, 6, 2) & "/" & Mid(s, 9, 2)
        End If
    Else
        NormalizeGetValue = v
    End If
End Function

'******************************************************************************
'REST API呼出処理
'　method　GetかPOSTか
'　url　REST APIのURL
'　urlParam　リクエストパラメータ（オプション）
'　headers　ヘッダ（オプション）
Function callRestApi(Byval method As String, Byval url As String, Optional Byval urlParam As String = "", Optional Byval headers As Dictionary = Null, Optional Byval body As Dictionary = Null) As Object

    'HTTPリクエストのオブジェクトを定義
    Dim objHTTP As Object
    Set objHTTP = New XMLHTTP60

    'HTTPリクエストの接続先を設定
    objHTTP.Open method, url & urlParam, False

    'リクエストヘッダーを設定（複数ある場合はsetRequestHeaderを複数書けば良いのだ〜）
    Dim i As Long
    For i = 0 To headers.count - 1
        objHTTP.setRequestHeader headers.keys(i), headers.items(i)
    Next i

    'デバッグ用: 送信するリクエストボディを出力（必要な時だけコメントアウトを外す）
    'Debug.Print "  [DEBUG] Request Body: " & JsonConverter.ConvertToJson(body)

    'リクエスト送信
    objHTTP.send JsonConverter.ConvertToJson(body)

    Do While objHTTP.readyState < 4
        DoEvents
    Loop

    'デバッグ用: レスポンス全文を出力（必要な時だけコメントアウトを外す）
    'Debug.Print "  [DEBUG] Response Status: " & objHTTP.Status & " " & objHTTP.statusText
    'Debug.Print "  [DEBUG] Response Body (全文):"
    'Debug.Print objHTTP.responseText

    'レスポンスの文字列（objHTTP.responseText）をJsonに変換して返却
    Set callRestApi = JsonConverter.ParseJson(objHTTP.responseText)

End Function


'******************************************************************************
'基本情報シートにFilter表(F2:G2)・Sorter表(H2:I2)のテーブルをセットアップする
'新版着工要因閲覧シートv0.1.xlsm上で手動実行する想定（run()からは呼ばない）
'既にテーブルが存在する場合は何もしない
Sub SetupFilterSorterTables()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets("基本情報")

    Dim filterTbl As ListObject
    On Error Resume Next
    Set filterTbl = ws.ListObjects("FilterTable")
    On Error GoTo 0

    If filterTbl Is Nothing Then
        Dim filterHeader As Range
        Set filterHeader = ws.Range("F2:G2")
        filterHeader.Cells(1, 1).Value = "列名"
        filterHeader.Cells(1, 2).Value = "値"
        Set filterTbl = ws.ListObjects.Add(xlSrcRange, filterHeader, , xlYes)
        filterTbl.Name = "FilterTable"
    End If

    Dim sorterTbl As ListObject
    On Error Resume Next
    Set sorterTbl = ws.ListObjects("SorterTable")
    On Error GoTo 0

    If sorterTbl Is Nothing Then
        Dim sorterHeader As Range
        Set sorterHeader = ws.Range("J2:K2")
        sorterHeader.Cells(1, 1).Value = "列名"
        sorterHeader.Cells(1, 2).Value = "昇降順"
        Set sorterTbl = ws.ListObjects.Add(xlSrcRange, sorterHeader, , xlYes)
        sorterTbl.Name = "SorterTable"
    End If
End Sub

'******************************************************************************
'ブック内の全シートからテーブル名でテーブル（ListObject）を探し、CSVデータ（ヘッダ行を除く）を上書きする。
'シート名は問わない。テーブルが見つからない場合は新規作成せずメッセージを出して終了する
Function exportCSVDataToExistingTable(csvData As Variant, tableName As String)
    Debug.Print "CSVデータを既存テーブルに出力開始: " & tableName

    Dim tbl As ListObject
    Set tbl = FindListObjectByName(tableName)

    If tbl Is Nothing Then
        MsgBox "テーブルが存在しません: " & tableName, vbExclamation
        Exit Function
    End If

    Dim i As Long, j As Long
    Dim arr() As Variant
    Dim maxCols As Long

    Dim rows As Collection
    Set rows = ParseCsv(csvData)

    If rows.count <= 1 Then
        Debug.Print "データが0件のため、既存テーブルのデータ部分をクリアします: " & tableName
        If tbl.Range.Rows.count > 1 Then
            tbl.Range.Resize(tbl.Range.Rows.count - 1, tbl.Range.Columns.count).Offset(1, 0).ClearContents
        End If
        Exit Function
    End If

    maxCols = 0
    Dim rowArr As Variant
    For Each rowArr In rows
        If UBound(rowArr) + 1 > maxCols Then
            maxCols = UBound(rowArr) + 1
        End If
    Next rowArr

    ReDim arr(0 To rows.count - 1, 0 To maxCols - 1)

    i = 0
    For Each rowArr In rows
        For j = LBound(rowArr) To UBound(rowArr)
            arr(i, j) = rowArr(j)
        Next j
        i = i + 1
    Next rowArr

    '既存データ部分を毎回クリア（DataBodyRangeプロパティは内部状態が更新されず
    'Nothingのままになることがあるため使わず、テーブル範囲から直接計算する）
    If tbl.Range.Rows.count > 1 Then
        tbl.Range.Resize(tbl.Range.Rows.count - 1, tbl.Range.Columns.count).Offset(1, 0).ClearContents
    End If

    ' テーブルを目的のサイズにリサイズ
    tbl.Resize tbl.Range.Resize(rows.count, maxCols)

    Dim dataArr() As Variant
    ReDim dataArr(1 To rows.count - 1, 1 To maxCols)
    For i = 1 To rows.count - 1
        For j = 1 To maxCols
            dataArr(i, j) = arr(i, j - 1)
        Next j
    Next i

    'データ書き込み（DataBodyRangeプロパティを使わず、ヘッダ行の次からテーブル範囲を直接計算する）
    Dim dataRange As Range
    Set dataRange = tbl.Range.Resize(rows.count - 1, maxCols).Offset(1, 0)
    dataRange.Value = dataArr

    Debug.Print "CSVデータを既存テーブルに出力完了: " & tableName
End Function

'テーブルID 96243（営業所マスタ）をExport方式で全件取得し、「営業所」シートの既存テーブルを更新する
'ソートはNumA昇順で固定。Filterは使用しない。ヘッダ行は既存テーブルのものをそのまま使い、
'エクスポートしたCSVのヘッダ行（1行目）は捨てる。新規シート・テーブルの作成は行わない
Sub runSalesOfficeExport()
    Call init

    Dim resData As Variant

    'ソート条件（NumA昇順）を固定で組み立てる
    Dim colSorter As New Dictionary
    colSorter.Add "NumA", "asc"
    Dim viewObj As New Dictionary
    viewObj.Add "ColumnSorterHash", colSorter

    Debug.Print "データ取得処理開始（営業所マスタ Export）"
    resData = exportCSVData("96243", viewObj)

    If IsEmpty(resData) Or resData = "" Then
        Debug.Print "データが取得できませんでした"
    Else
        Call exportCSVDataToExistingTable(resData, "営業所")
    End If
End Sub