継続文字連結処理

Option Explicit
Option Base 1

'--------------------------------------------------
'プロシージャの概要:
'処理名:継続文字連結処理
'概要:t02b_TrimCodeテーブルの継続文字で分割されたコードを連結してt02c_継続文字連結テーブルを作成する
'--------------------------------------------------
Public Sub prcCreate継続文字連結()
    Dim dbs As DAO.Database
    Dim rstSource As DAO.Recordset
    Dim rstTarget As DAO.Recordset
    Dim strSQL As String
    Dim lngCurrentLineID As Long
    Dim strCurrentCode As String
    Dim strCombinedCode As String
    Dim lngStartLineID As Long
    Dim blnInContinuation As Boolean
    Dim lngProcessedCount As Long
    Dim strTrimmedCode As String
    
    ' カレントデータベースを取得
    Set dbs = CurrentDb
    
    ' 既存データをクリア
    dbs.Execute "DELETE FROM t02c_継続文字連結"
    
    ' レコードセットを開く
    strSQL = ""
    strSQL = strSQL & "SELECT * FROM t02b_TrimCode"
    strSQL = strSQL & " ORDER BY CodeLineID"
    Set rstSource = dbs.OpenRecordset(strSQL)
    
    Set rstTarget = dbs.OpenRecordset("t02c_継続文字連結")
    
    ' 初期化
    lngProcessedCount = 0
    blnInContinuation = False
    
    ' 各レコードを処理
    Do While Not rstSource.EOF
        lngCurrentLineID = rstSource!CodeLineID
        strCurrentCode = Nz(rstSource!TrimCode, "")
        
        ' 継続文字チェック（行末が_で終わっているか）
        strTrimmedCode = Trim(strCurrentCode)
        If Len(strTrimmedCode) > 0 And Right(strTrimmedCode, 1) = "_" Then
            ' 継続行の場合：継続文字（_）を除去
            strTrimmedCode = Trim(Left(strTrimmedCode, Len(strTrimmedCode) - 1))
            
            If Not blnInContinuation Then
                ' 継続開始
                lngStartLineID = lngCurrentLineID
                strCombinedCode = strTrimmedCode
                blnInContinuation = True
            Else
                ' 継続中
                strCombinedCode = strCombinedCode & " " & strTrimmedCode
            End If
        Else
            ' 継続文字なしの行
            If blnInContinuation Then
                ' 継続終了：最後の行を連結
                strCombinedCode = strCombinedCode & " " & strCurrentCode
                
                ' 連結結果をテーブルに追加
                rstTarget.AddNew
                rstTarget!連結コードラインID = lngStartLineID
                rstTarget!連結コード = strCombinedCode
                rstTarget.Update
                lngProcessedCount = lngProcessedCount + 1
                
                ' リセット
                blnInContinuation = False
                strCombinedCode = ""
            Else
                ' 単独行
                rstTarget.AddNew
                rstTarget!連結コードラインID = lngCurrentLineID
                rstTarget!連結コード = strCurrentCode
                rstTarget.Update
                lngProcessedCount = lngProcessedCount + 1
            End If
        End If
        
        rstSource.MoveNext
    Loop
    
    ' 最後が継続行で終わっている場合の処理
    If blnInContinuation And Len(strCombinedCode) > 0 Then
        rstTarget.AddNew
        rstTarget!連結コードラインID = lngStartLineID
        rstTarget!連結コード = strCombinedCode
        rstTarget.Update
        lngProcessedCount = lngProcessedCount + 1
    End If
    
    ' リソース解放
    rstSource.Close
    rstTarget.Close
    Set rstSource = Nothing
    Set rstTarget = Nothing
    Set dbs = Nothing
    
    MsgBox "継続文字連結処理が完了しました。" & vbCrLf & _
           "処理件数: " & lngProcessedCount, vbInformation
End Sub