Option Explicit

Private Const wdFormatXMLDocument As Long = 12
Private Const msoFileDialogFilePicker As Long = 3
Private Const msoFileDialogFolderPicker As Long = 4
Private Const wdFormLetters As Long = 0
Private Const wdNotAMergeDocument As Long = -1
Private Const wdNoActiveRecord As Long = -1
Private Const wdNextRecord As Long = -2
Private Const wdFirstRecord As Long = -4

Public gQueue As Collection

' ★ 워드 프로그램 내부에만 존재하는 안전한 메모리(RAM) 저장소
Public gPersonCache As Collection
Public gCacheLoadedPath As String
Private gDataSourcePath As String

Public Sub AutoOpen()
    ResetTemplateData ActiveDocument
    If Application.Visible Then ShowDisciplineForm
End Sub

Public Sub ShowDisciplineForm()
    InitializeQueue
    ResetTemplateData ActiveDocument
    UserForm1.Show
End Sub

Public Sub InitializeQueue()
    If gQueue Is Nothing Then Set gQueue = New Collection
End Sub

' ★ [수정 완료] 워드를 끌 때는 파쇄기를 돌리지 않고 연결만 안전하게 닫습니다. (데이터 영구 보존)
Public Sub CloseDataConnection()
    On Error Resume Next
    If Len(gDataSourcePath) > 0 Then
        ActiveDocument.MailMerge.MainDocumentType = wdNotAMergeDocument
    End If
    gDataSourcePath = ""
    On Error GoTo 0
End Sub

' ★★★ [보안 핵심] 새로운 엑셀 파일을 선택할 때만 기존 데이터를 흔적도 없이 밀어버리는 파쇄 함수 ★★★
Public Sub ClearWordFileCache()
    Dim i As Long
    On Error Resume Next
    
    ' 1. 워드 문서 메타데이터 공간(Variables)을 역순으로 뒤져 기존 캐시 조각들 완전 삭제
    For i = ActiveDocument.Variables.Count To 1 Step -1
        If Left$(ActiveDocument.Variables(i).Name, 10) = "CacheChunk" Then
            ActiveDocument.Variables(i).Delete
        End If
    Next i
    
    ' 2. 저장된 엑셀 경로 변수도 삭제
    ActiveDocument.Variables("CacheExcelPath").Delete
    
    ' 3. 워드가 메모리(RAM)에 일시적으로 올렸던 컬렉션도 완벽히 비우기
    Set gPersonCache = Nothing
    gCacheLoadedPath = ""
    
    ' 4. 변경된 문서 구조를 강제로 반영 및 저장 유도
    If Not ActiveDocument.Saved Then ActiveDocument.Saved = False
    On Error GoTo 0
End Sub

Public Function SelectExcelFile(Optional ByVal currentPath As String = "") As String
    Dim picker As FileDialog
    Set picker = Application.FileDialog(msoFileDialogFilePicker)
    With picker
        .Title = "인적사항을 조회할 엑셀 파일 선택"
        .AllowMultiSelect = False
        .Filters.Clear
        .Filters.Add "Excel 파일", "*.xlsx;*.xlsm;*.xls"
        If Len(currentPath) > 0 Then .InitialFileName = currentPath
        If .Show <> -1 Then Exit Function
        SelectExcelFile = .SelectedItems(1)
    End With
End Function

Public Function SelectSaveFolder(Optional ByVal currentPath As String = "") As String
    Dim picker As FileDialog
    Set picker = Application.FileDialog(msoFileDialogFolderPicker)
    With picker
        .Title = "생성한 Word 파일을 저장할 폴더 선택"
        .AllowMultiSelect = False
        If Len(currentPath) > 0 Then .InitialFileName = AddTrailingSlash(currentPath)
        If .Show <> -1 Then Exit Function
        SelectSaveFolder = .SelectedItems(1)
    End With
End Function

Public Function DefaultSaveFolder() As String
    DefaultSaveFolder = Options.DefaultFilePath(wdDocumentsPath)
End Function

Public Function LookupPersonSummary(ByVal excelPath As String, ByVal rawNumber As String) As String
    Dim person As Variant, message As String, numbers As Collection
    Set numbers = ParseNumbers(rawNumber)
    If numbers.Count <> 1 Then
        LookupPersonSummary = "조회할 번호 하나를 입력해 주세요."
        Exit Function
    End If

    If LookupPerson(excelPath, CStr(numbers(1)), person, message) Then
        LookupPersonSummary = "성명: " & CStr(person(1)) & vbCrLf & _
                              "죄명: " & CStr(person(2)) & vbCrLf & _
                              "형명형기: " & NormalizeSentenceTerm(CStr(person(3))) & vbCrLf & _
                              "범수/경비처우급: " & CStr(person(6)) & vbCrLf & _
                              "형기종료일: " & NormalizeEndDate(CStr(person(7)))
    Else
        LookupPersonSummary = message
    End If
End Function

Public Function QueueAddNumbers(ByVal excelPath As String, ByVal rawNumbers As String, ByVal violationDate As String, ByVal violationContent As String, ByVal reporter As String, ByVal confirmer As String, ByVal note As String, ByRef addedCount As Long, ByRef resultMessage As String) As Boolean
    Dim numbers As Collection, item As Variant, person As Variant, record As Variant
    Dim message As String, failures As String

    InitializeQueue
    addedCount = 0

    Set numbers = ParseNumbers(rawNumbers)
    If numbers.Count = 0 Then resultMessage = "번호를 입력해 주세요.": Exit Function

    For Each item In numbers
        If LookupPerson(excelPath, CStr(item), person, message) Then
            record = MakeQueueRecord(person, violationDate, violationContent, reporter, confirmer, note)
            gQueue.Add record
            addedCount = addedCount + 1
        Else
            If Len(failures) > 0 Then failures = failures & vbCrLf
            failures = failures & CStr(item) & ": " & message
        End If
    Next item

    If addedCount > 0 Then
        resultMessage = CStr(addedCount) & "건을 목록에 추가했습니다."
        If Len(failures) > 0 Then resultMessage = resultMessage & vbCrLf & vbCrLf & "추가하지 못한 번호:" & vbCrLf & failures
        QueueAddNumbers = True
    Else
        resultMessage = failures
    End If
End Function

Private Function BuildSingleRecord(ByVal excelPath As String, ByVal rawNumber As String, _
                                   ByVal violationDate As String, ByVal violationContent As String, _
                                   ByVal reporter As String, ByVal confirmer As String, _
                                   ByVal note As String, ByRef record As Variant, _
                                   ByRef resultMessage As String) As Boolean
    Dim numbers As Collection, person As Variant, lookupMessage As String

    Set numbers = ParseNumbers(rawNumber)
    If numbers.Count <> 1 Then
        resultMessage = "바로 처리할 번호 하나만 입력해 주세요."
        Exit Function
    End If

    If Not LookupPerson(excelPath, CStr(numbers(1)), person, lookupMessage) Then
        resultMessage = lookupMessage
        Exit Function
    End If

    record = MakeQueueRecord(person, violationDate, violationContent, reporter, confirmer, note)
    BuildSingleRecord = True
End Function

Private Function MakeQueueRecord(ByVal person As Variant, ByVal violationDate As String, _
                                 ByVal violationContent As String, ByVal reporter As String, _
                                 ByVal confirmer As String, ByVal note As String) As Variant
    MakeQueueRecord = Array( _
        CStr(person(0)), CStr(person(1)), CStr(person(2)), _
        NormalizeSentenceTerm(CStr(person(3))), CStr(person(4)), CStr(person(5)), _
        CStr(person(6)), NormalizeEndDate(CStr(person(7))), _
        Trim$(violationDate), Trim$(violationContent), Trim$(reporter), Trim$(confirmer), Trim$(note))
End Function

Public Sub QueueRemove(ByVal listIndex As Long)
    InitializeQueue
    If listIndex < 0 Or listIndex >= gQueue.Count Then Exit Sub
    gQueue.Remove listIndex + 1
End Sub

Public Sub QueueClear()
    Set gQueue = New Collection
End Sub

Public Function QueueCount() As Long
    InitializeQueue
    QueueCount = gQueue.Count
End Function

Public Function QueueRecord(ByVal oneBasedIndex As Long) As Variant
    InitializeQueue
    QueueRecord = gQueue(oneBasedIndex)
End Function

Public Function PrintQueue(ByVal sourceDoc As Document, ByRef resultMessage As String) As Boolean
    Dim record As Variant, index As Long
    Dim errorText As String, fillMessage As String
    Dim oldScreenUpdating As Boolean, wasSaved As Boolean, oldTrackRevisions As Boolean

    On Error GoTo Fail
    InitializeQueue
    If gQueue.Count = 0 Then resultMessage = "인쇄할 명단이 없습니다.": Exit Function

    oldScreenUpdating = Application.ScreenUpdating
    wasSaved = sourceDoc.Saved
    oldTrackRevisions = sourceDoc.TrackRevisions
    Application.ScreenUpdating = False
    sourceDoc.TrackRevisions = False

    For index = 1 To gQueue.Count
        record = gQueue(index)
        If Not FillTemplateWithRecord(sourceDoc, record, fillMessage) Then
            resultMessage = CStr(index) & "번째 대상자 데이터를 입력하지 못했습니다." & vbCrLf & fillMessage
            GoTo CleanExit
        End If

        sourceDoc.PrintOut Background:=False
        ResetTemplateData sourceDoc
    Next index

    resultMessage = CStr(gQueue.Count) & "건을 인쇄했습니다."
    PrintQueue = True
    GoTo CleanExit
Fail:
    errorText = Err.Description
    resultMessage = "인쇄 중 오류가 발생했습니다." & vbCrLf & errorText
CleanExit:
    On Error Resume Next
    ResetTemplateData sourceDoc
    sourceDoc.TrackRevisions = oldTrackRevisions
    If wasSaved Then sourceDoc.Saved = True
    Application.ScreenUpdating = oldScreenUpdating
    On Error GoTo 0
End Function

Public Function CreateQueueFile(ByVal sourceDoc As Document, ByVal saveFolder As String, ByRef outputPath As String, ByRef resultMessage As String) As Boolean
    Dim outputDoc As Document, record As Variant, index As Long
    Dim fillMessage As String, errorText As String, currentPath As String, createdPaths As String
    Dim oldScreenUpdating As Boolean, wasSaved As Boolean, oldTrackRevisions As Boolean

    On Error GoTo Fail
    InitializeQueue
    outputPath = ""
    If gQueue.Count = 0 Then resultMessage = "파일로 만들 명단이 없습니다.": Exit Function
    If Not FolderExists(saveFolder) Then resultMessage = "저장 폴더를 선택해 주세요.": Exit Function

    oldScreenUpdating = Application.ScreenUpdating
    wasSaved = sourceDoc.Saved
    oldTrackRevisions = sourceDoc.TrackRevisions
    Application.ScreenUpdating = False
    sourceDoc.TrackRevisions = False
    Set outputDoc = Documents.Add(Visible:=False)

    For index = 1 To gQueue.Count
        record = gQueue(index)
        If Not FillTemplateWithRecord(sourceDoc, record, fillMessage) Then
            outputPath = createdPaths
            resultMessage = CStr(index) & "번째 대상자 데이터를 입력하지 못했습니다." & vbCrLf & fillMessage
            GoTo CleanExit
        End If

        CopyFilledTemplate sourceDoc, outputDoc
        ResetTemplateData sourceDoc

        currentPath = NextAvailableOutputPath(saveFolder, record)
        outputDoc.SaveAs2 FileName:=currentPath, FileFormat:=wdFormatXMLDocument

        If Len(createdPaths) > 0 Then createdPaths = createdPaths & vbCrLf
        createdPaths = createdPaths & currentPath
    Next index

    outputPath = createdPaths
    resultMessage = CStr(gQueue.Count) & "개의 Word 파일을 각각 생성했습니다."
    CreateQueueFile = True
    GoTo CleanExit
Fail:
    errorText = Err.Description
    outputPath = createdPaths
    resultMessage = "파일 생성 중 오류가 발생했습니다." & vbCrLf & errorText
CleanExit:
    On Error Resume Next
    ResetTemplateData sourceDoc
    If Not outputDoc Is Nothing Then outputDoc.Close SaveChanges:=False
    sourceDoc.TrackRevisions = oldTrackRevisions
    If wasSaved Then sourceDoc.Saved = True
    Application.ScreenUpdating = oldScreenUpdating
    On Error GoTo 0
End Function

Public Function PrintQueueWithFiles(ByVal sourceDoc As Document, ByVal saveFolder As String, ByRef outputPath As String, ByRef resultMessage As String) As Boolean
    Dim outputDoc As Document, record As Variant, index As Long
    Dim fillMessage As String, errorText As String, currentPath As String, createdPaths As String
    Dim oldScreenUpdating As Boolean, wasSaved As Boolean, oldTrackRevisions As Boolean

    On Error GoTo Fail
    InitializeQueue
    outputPath = ""
    If gQueue.Count = 0 Then resultMessage = "인쇄할 명단이 없습니다.": Exit Function
    If Not FolderExists(saveFolder) Then resultMessage = "저장 폴더를 선택해 주세요.": Exit Function

    oldScreenUpdating = Application.ScreenUpdating
    wasSaved = sourceDoc.Saved
    oldTrackRevisions = sourceDoc.TrackRevisions
    Application.ScreenUpdating = False
    sourceDoc.TrackRevisions = False
    Set outputDoc = Documents.Add(Visible:=False)

    For index = 1 To gQueue.Count
        record = gQueue(index)
        If Not FillTemplateWithRecord(sourceDoc, record, fillMessage) Then
            outputPath = createdPaths
            resultMessage = CStr(index) & "번째 대상자 데이터를 입력하지 못했습니다." & vbCrLf & fillMessage
            GoTo CleanExit
        End If

        sourceDoc.PrintOut Background:=False
        CopyFilledTemplate sourceDoc, outputDoc
        currentPath = NextAvailableOutputPath(saveFolder, record)
        outputDoc.SaveAs2 FileName:=currentPath, FileFormat:=wdFormatXMLDocument

        If Len(createdPaths) > 0 Then createdPaths = createdPaths & vbCrLf
        createdPaths = createdPaths & currentPath
        ResetTemplateData sourceDoc
    Next index

    outputPath = createdPaths
    resultMessage = CStr(gQueue.Count) & "건의 인쇄와 개별 파일 생성이 완료되었습니다."
    PrintQueueWithFiles = True
    GoTo CleanExit
Fail:
    errorText = Err.Description
    outputPath = createdPaths
    resultMessage = "인쇄 또는 파일 생성 중 오류가 발생했습니다." & vbCrLf & errorText
CleanExit:
    On Error Resume Next
    ResetTemplateData sourceDoc
    If Not outputDoc Is Nothing Then outputDoc.Close SaveChanges:=False
    sourceDoc.TrackRevisions = oldTrackRevisions
    If wasSaved Then sourceDoc.Saved = True
    Application.ScreenUpdating = oldScreenUpdating
    On Error GoTo 0
End Function

Public Function PrintSingleRecord(ByVal sourceDoc As Document, ByVal excelPath As String, ByVal rawNumber As String, ByVal violationDate As String, ByVal violationContent As String, ByVal reporter As String, ByVal confirmer As String, ByVal note As String, ByRef resultMessage As String) As Boolean
    Dim record As Variant, errorText As String, fillMessage As String
    Dim oldScreenUpdating As Boolean, wasSaved As Boolean, oldTrackRevisions As Boolean

    On Error GoTo Fail
    If Not BuildSingleRecord(excelPath, rawNumber, violationDate, violationContent, reporter, confirmer, note, record, resultMessage) Then Exit Function

    oldScreenUpdating = Application.ScreenUpdating
    wasSaved = sourceDoc.Saved
    oldTrackRevisions = sourceDoc.TrackRevisions
    Application.ScreenUpdating = False
    sourceDoc.TrackRevisions = False

    If Not FillTemplateWithRecord(sourceDoc, record, fillMessage) Then
        resultMessage = fillMessage
        GoTo CleanExit
    End If
    sourceDoc.PrintOut Background:=False

    resultMessage = CStr(record(0)) & " " & CStr(record(1)) & " 인쇄가 완료되었습니다."
    PrintSingleRecord = True
    GoTo CleanExit
Fail:
    errorText = Err.Description
    resultMessage = "바로 인쇄 중 오류가 발생했습니다." & vbCrLf & errorText
CleanExit:
    On Error Resume Next
    ResetTemplateData sourceDoc
    sourceDoc.TrackRevisions = oldTrackRevisions
    If wasSaved Then sourceDoc.Saved = True
    Application.ScreenUpdating = oldScreenUpdating
    On Error GoTo 0
End Function

Public Function PrintSingleRecordWithFile(ByVal sourceDoc As Document, ByVal excelPath As String, ByVal rawNumber As String, ByVal violationDate As String, ByVal violationContent As String, ByVal reporter As String, ByVal confirmer As String, ByVal note As String, ByVal saveFolder As String, ByRef outputPath As String, ByRef resultMessage As String) As Boolean
    Dim outputDoc As Document, record As Variant, fillMessage As String, errorText As String
    Dim oldScreenUpdating As Boolean, wasSaved As Boolean, oldTrackRevisions As Boolean

    On Error GoTo Fail
    outputPath = ""
    If Not FolderExists(saveFolder) Then resultMessage = "저장 폴더를 선택해 주세요.": Exit Function
    If Not BuildSingleRecord(excelPath, rawNumber, violationDate, violationContent, reporter, confirmer, note, record, resultMessage) Then Exit Function

    oldScreenUpdating = Application.ScreenUpdating
    wasSaved = sourceDoc.Saved
    oldTrackRevisions = sourceDoc.TrackRevisions
    Application.ScreenUpdating = False
    sourceDoc.TrackRevisions = False

    If Not FillTemplateWithRecord(sourceDoc, record, fillMessage) Then
        resultMessage = fillMessage
        GoTo CleanExit
    End If

    sourceDoc.PrintOut Background:=False
    Set outputDoc = Documents.Add(Visible:=False)
    CopyFilledTemplate sourceDoc, outputDoc
    outputPath = NextAvailableOutputPath(saveFolder, record)
    outputDoc.SaveAs2 FileName:=outputPath, FileFormat:=wdFormatXMLDocument

    resultMessage = CStr(record(0)) & " " & CStr(record(1)) & " 인쇄와 파일 생성이 완료되었습니다."
    PrintSingleRecordWithFile = True
    GoTo CleanExit
Fail:
    errorText = Err.Description
    resultMessage = "인쇄 또는 파일 생성 중 오류가 발생했습니다." & vbCrLf & errorText
CleanExit:
    On Error Resume Next
    ResetTemplateData sourceDoc
    If Not outputDoc Is Nothing Then outputDoc.Close SaveChanges:=False
    sourceDoc.TrackRevisions = oldTrackRevisions
    If wasSaved Then sourceDoc.Saved = True
    Application.ScreenUpdating = oldScreenUpdating
    On Error GoTo 0
End Function

Public Function CreateSingleRecordFile(ByVal sourceDoc As Document, ByVal excelPath As String, ByVal rawNumber As String, ByVal violationDate As String, ByVal violationContent As String, ByVal reporter As String, ByVal confirmer As String, ByVal note As String, ByVal saveFolder As String, ByRef outputPath As String, ByRef resultMessage As String) As Boolean
    Dim outputDoc As Document, record As Variant, fillMessage As String, errorText As String
    Dim oldScreenUpdating As Boolean, wasSaved As Boolean, oldTrackRevisions As Boolean

    On Error GoTo Fail
    outputPath = ""
    If Not FolderExists(saveFolder) Then resultMessage = "저장 폴더를 선택해 주세요.": Exit Function
    If Not BuildSingleRecord(excelPath, rawNumber, violationDate, violationContent, reporter, confirmer, note, record, resultMessage) Then Exit Function

    oldScreenUpdating = Application.ScreenUpdating
    wasSaved = sourceDoc.Saved
    oldTrackRevisions = sourceDoc.TrackRevisions
    Application.ScreenUpdating = False
    sourceDoc.TrackRevisions = False

    If Not FillTemplateWithRecord(sourceDoc, record, fillMessage) Then
        resultMessage = fillMessage
        GoTo CleanExit
    End If

    Set outputDoc = Documents.Add(Visible:=False)
    CopyFilledTemplate sourceDoc, outputDoc
    ResetTemplateData sourceDoc

    outputPath = NextAvailableOutputPath(saveFolder, record)
    outputDoc.SaveAs2 FileName:=outputPath, FileFormat:=wdFormatXMLDocument

    resultMessage = CStr(record(0)) & " " & CStr(record(1)) & " 파일을 생성했습니다."
    CreateSingleRecordFile = True
    GoTo CleanExit
Fail:
    errorText = Err.Description
    resultMessage = "파일 생성 중 오류가 발생했습니다." & vbCrLf & errorText
CleanExit:
    On Error Resume Next
    ResetTemplateData sourceDoc
    If Not outputDoc Is Nothing Then outputDoc.Close SaveChanges:=False
    sourceDoc.TrackRevisions = oldTrackRevisions
    If wasSaved Then sourceDoc.Saved = True
    Application.ScreenUpdating = oldScreenUpdating
    On Error GoTo 0
End Function

Public Sub ResetTemplateData(ByVal sourceDoc As Document)
    Dim personTableIndex As Long, violationTableIndex As Long
    Dim wasSaved As Boolean, oldTrackRevisions As Boolean

    On Error Resume Next
    If sourceDoc Is Nothing Then Exit Sub
    wasSaved = sourceDoc.Saved
    oldTrackRevisions = sourceDoc.TrackRevisions
    sourceDoc.TrackRevisions = False

    If FindTemplateTables(sourceDoc, personTableIndex, violationTableIndex) Then
        ClearTableRows sourceDoc.Tables(personTableIndex), 2
        ClearTableRows sourceDoc.Tables(violationTableIndex), 2
    End If

    sourceDoc.TrackRevisions = oldTrackRevisions
    If wasSaved Then sourceDoc.Saved = True
    On Error GoTo 0
End Sub

Private Function FillTemplateWithRecord(ByVal sourceDoc As Document, ByVal record As Variant, ByRef resultMessage As String) As Boolean
    Dim personTableIndex As Long, violationTableIndex As Long

    On Error GoTo Fail
    If Not FindTemplateTables(sourceDoc, personTableIndex, violationTableIndex) Then
        resultMessage = "문서에서 필요한 인적사항 표와 규율위반사항 표를 찾을 수 없습니다."
        Exit Function
    End If

    ClearTableRows sourceDoc.Tables(personTableIndex), 2
    ClearTableRows sourceDoc.Tables(violationTableIndex), 2
    FillPersonTable sourceDoc.Tables(personTableIndex), record
    FillViolationTable sourceDoc.Tables(violationTableIndex), record
    FillTemplateWithRecord = True
    Exit Function
Fail:
    resultMessage = "양식 표에 데이터를 입력하는 중 오류가 발생했습니다." & vbCrLf & Err.Description
End Function

Private Sub CopyFilledTemplate(ByVal sourceDoc As Document, ByVal outputDoc As Document)
    CopyPageSetup sourceDoc, outputDoc
    outputDoc.Content.Delete
    outputDoc.Content.FormattedText = sourceDoc.Content.FormattedText
End Sub

' ★ [조회 분기] 메모리가 깨끗하게 비어있다면 워드 파일 뱃속에서 조용히 꺼내옵니다.
Private Function LookupPerson(ByVal excelPath As String, ByVal personNumber As String, ByRef person As Variant, ByRef resultMessage As String) As Boolean
    Dim targetNumber As String
    targetNumber = NormalizeIdentifier(personNumber)
    If Len(targetNumber) = 0 Then resultMessage = "번호가 비어 있습니다.": Exit Function

    ' 워드를 껐다 켜서 RAM 공간이 완전히 빈 경우에만 파일 뱃속에서 복원 시도
    If gPersonCache Is Nothing Then
        If Not LoadCacheFromWordFile(excelPath) Then
            ' 파일 내부(Variables)에도 전혀 없다면 최초 엑셀 동기화 실행
            If Not LoadExcelDataCache(excelPath, resultMessage) Then Exit Function
        End If
    End If

    ' 워드 내부 초고속 검색 (0.001초 소요)
    On Error Resume Next
    person = gPersonCache(targetNumber)
    If Err.Number = 0 Then
        resultMessage = "조회 완료"
        LookupPerson = True
    Else
        resultMessage = "명단에서 해당 번호를 찾지 못했습니다."
        LookupPerson = False
    End If
    On Error GoTo 0
End Function

' ★ [새 원본 이식 엔진] 새로운 파일 선택 버튼을 누를 때만 기존 잔재를 파쇄하고 새로 삼킵니다.
Public Function LoadExcelDataCache(ByVal excelPath As String, ByRef resultMessage As String) As Boolean
    Dim dataSource As Object
    Dim recordIndex As Long, recordCount As Long, previousRecord As Long
    Dim currentNumber As String, securityClass As String, repeatCount As String, combinedClass As String
    Dim person As Variant, checkCols As Long

    On Error GoTo Fail
    If Len(Dir$(excelPath)) = 0 Then resultMessage = "선택한 엑셀 파일을 찾을 수 없습니다.": Exit Function

    ' 사용자가 새 파일을 골랐으므로, 기존 문서변수 데이터 조각들을 완벽히 지워 세척함
    ClearWordFileCache

    Set gPersonCache = New Collection
    
    With ActiveDocument.MailMerge
        .MainDocumentType = wdFormLetters
        .OpenDataSource Name:=excelPath, ConfirmConversions:=False, ReadOnly:=True, LinkToSource:=False, AddToRecentFiles:=False
    End With
    Set dataSource = ActiveDocument.MailMerge.DataSource
    
    On Error Resume Next
    checkCols = dataSource.DataFields.Count
    On Error GoTo Fail
    If checkCols < 17 Then
        resultMessage = "엑셀 표 구조 인식 실패: 1~5행 병합 셀 확인 요망."
        ActiveDocument.MailMerge.MainDocumentType = wdNotAMergeDocument
        Exit Function
    End If

    recordCount = WordDataRecordCount(dataSource)
    dataSource.ActiveRecord = wdFirstRecord

    For recordIndex = 1 To recordCount
        If dataSource.ActiveRecord = wdNoActiveRecord Then Exit For
        currentNumber = NormalizeIdentifier(WordDataFieldText(dataSource, 3))

        If Len(currentNumber) > 0 And InStr(1, currentNumber, "번호") = 0 And InStr(1, currentNumber, "수번") = 0 Then
            securityClass = NormalizeSecurityClass(WordDataFieldText(dataSource, 12))
            repeatCount = NormalizeRepeatCount(WordDataFieldText(dataSource, 13))
            combinedClass = CombineValues(repeatCount, securityClass)
            
            person = Array(WordDataFieldText(dataSource, 3), WordDataFieldText(dataSource, 4), _
                           WordDataFieldText(dataSource, 14), ValueOrPending(WordDataFieldText(dataSource, 15)), _
                           securityClass, repeatCount, combinedClass, WordDataFieldText(dataSource, 17))
            On Error Resume Next
            gPersonCache.Add person, currentNumber
            On Error GoTo Fail
        End If

        If recordIndex >= recordCount Then Exit For
        previousRecord = dataSource.ActiveRecord
        dataSource.ActiveRecord = wdNextRecord
        If dataSource.ActiveRecord = previousRecord Then Exit For
    Next recordIndex

    ActiveDocument.MailMerge.MainDocumentType = wdNotAMergeDocument
    gDataSourcePath = ""
    
    ' 새로 불러온 완벽한 데이터를 워드 내부 메타데이터 변수로 주입 및 영구 보존
    SaveCacheToWordFile excelPath
    
    LoadExcelDataCache = True
    Exit Function
Fail:
    On Error Resume Next
    ActiveDocument.MailMerge.MainDocumentType = wdNotAMergeDocument
    resultMessage = "데이터 로딩 오류: " & Err.Description
End Function

' ★ [이식 실행] 외부 찌꺼기를 일절 배출하지 않고 워드 안전 구역에 데이터를 주입함
Private Sub SaveCacheToWordFile(ByVal excelPath As String)
    Dim i As Long
    For i = ActiveDocument.Variables.Count To 1 Step -1
        If Left$(ActiveDocument.Variables(i).Name, 10) = "CacheChunk" Then
            ActiveDocument.Variables(i).Delete
        End If
    Next i
    On Error Resume Next
    ActiveDocument.Variables("CacheExcelPath").Delete
    On Error GoTo 0
    
    ActiveDocument.Variables.Add Name:="CacheExcelPath", Value:=excelPath
    
    Dim chunk As String, chunkIndex As Long, dataLine As String, item As Variant
    chunkIndex = 1
    chunk = ""
    
    For Each item In gPersonCache
        dataLine = item(0) & "|" & item(1) & "|" & item(2) & "|" & item(3) & "|" & item(4) & "|" & item(5) & "|" & item(6) & "|" & item(7) & "[SPLIT]"
        If Len(chunk) + Len(dataLine) > 60000 Then
            ActiveDocument.Variables.Add Name:="CacheChunk" & CStr(chunkIndex), Value:=chunk
            chunkIndex = chunkIndex + 1
            chunk = ""
        End If
        chunk = chunk & dataLine
    Next item
    
    If Len(chunk) > 0 Then
        ActiveDocument.Variables.Add Name:="CacheChunk" & CStr(chunkIndex), Value:=chunk
    End If
    
    ' 데이터를 보관 공간에 꽉 채운 후, 디스크에 즉시 조용히 저장
    If Not ActiveDocument.Saved Then ActiveDocument.Save
End Sub

' ★ [초고속 복원] 워드를 다시 기동했을 때 뱃속 청크 데이터들을 묶어 고속 조립
Private Function LoadCacheFromWordFile(ByVal expectedExcelPath As String) As Boolean
    Dim savedPath As String
    On Error Resume Next
    savedPath = ActiveDocument.Variables("CacheExcelPath").Value
    On Error GoTo Fail
    
    If Len(savedPath) = 0 Then Exit Function
    
    ' 만약 다른 경로의 엑셀 데이터 요청인 경우 복원하지 않고 통과
    If StrComp(savedPath, expectedExcelPath, vbTextCompare) <> 0 Then Exit Function
    
    Set gPersonCache = New Collection
    
    Dim chunkIndex As Long, chunk As String, parts() As String, records() As String
    Dim r As Long
    chunkIndex = 1
    
    Do
        chunk = ""
        On Error Resume Next
        chunk = ActiveDocument.Variables("CacheChunk" & CStr(chunkIndex)).Value
        On Error GoTo Fail
        If Len(chunk) = 0 Then Exit Do
        
        records = Split(chunk, "[SPLIT]")
        For r = 0 To UBound(records)
            If Len(records(r)) > 0 Then
                parts = Split(records(r), "|")
                If UBound(parts) = 7 Then
                    On Error Resume Next
                    gPersonCache.Add Array(parts(0), parts(1), parts(2), parts(3), parts(4), parts(5), parts(6), parts(7)), parts(0)
                    On Error GoTo FailRead
                End If
            End If
FailRead:
        Next r
        chunkIndex = chunkIndex + 1
    Loop
    
    gCacheLoadedPath = expectedExcelPath
    LoadCacheFromWordFile = True
    Exit Function
Fail:
    LoadCacheFromWordFile = False
End Function

Private Function WordDataRecordCount(ByVal dataSource As Object) As Long
    Dim result As Long
    On Error Resume Next
    result = CLng(dataSource.RecordCount)
    If result < 0 Then result = 100000
    On Error GoTo 0
    WordDataRecordCount = result
End Function

Private Function WordDataFieldText(ByVal dataSource As Object, ByVal fieldIndex As Long) As String
    On Error GoTo Done
    WordDataFieldText = Trim$(CStr(dataSource.DataFields(fieldIndex).Value))
Done:
End Function

Private Function NormalizeIdentifier(ByVal value As String) As String
    value = Trim$(value)
    value = Replace(value, " ", "")
    If Right$(value, 2) = ".0" Then value = Left$(value, Len(value) - 2)
    NormalizeIdentifier = LCase$(value)
End Function

Private Function ShortenYearText(ByVal value As String) As String
    Dim temp As String
    temp = Replace(value, "2023", "23")
    temp = Replace(temp, "2024", "24")
    temp = Replace(temp, "2025", "25")
    temp = Replace(temp, "2026", "26")
    ShortenYearText = temp
End Function

Private Function NormalizeEndDate(ByVal value As String) As String
    Dim temp As String
    Dim parts() As String
    
    temp = Trim$(value)
    If Len(temp) = 0 Then Exit Function
    
    temp = Replace(temp, "-", ".")
    temp = Replace(temp, "/", ".")
    temp = Replace(temp, "년", ".")
    temp = Replace(temp, "월", ".")
    temp = Replace(temp, "일", "")
    temp = Replace(temp, " ", "")
    
    Do While InStr(temp, "..") > 0
        temp = Replace(temp, "..", ".")
    Loop
    If Right$(temp, 1) = "." Then temp = Left$(temp, Len(temp) - 1)
    
    parts = Split(temp, ".")
    If UBound(parts) >= 2 Then
        If Len(parts(0)) = 4 Then parts(0) = Right$(parts(0), 2)
        If Len(parts(1)) = 1 Then parts(1) = "0" & parts(1)
        If Len(parts(2)) = 1 Then parts(2) = "0" & parts(2)
        
        NormalizeEndDate = parts(0) & "." & parts(1) & "." & parts(2)
    Else
        temp = Replace(temp, "2024", "24")
        temp = Replace(temp, "2025", "25")
        temp = Replace(temp, "2026", "26")
        NormalizeEndDate = temp
    End If
End Function

' ★★★ [버그 수정완료] 10년, 20년 방어 및 0년/0월 청소용 완벽 포맷팅 함수 ★★★
Private Function NormalizeSentenceTerm(ByVal value As String) As String
    Dim temp As String, result As String
    Dim i As Long, ch As String
    Dim currentNum As String
    Dim isFirstData As Boolean
    
    temp = Trim$(value)
    temp = Replace(temp, " ", "")
    
    If Len(temp) = 0 Then Exit Function
    
    temp = Replace(temp, "년", "년 ")
    temp = Replace(temp, "월", "월 ")
    temp = Replace(temp, "일", "일 ")
    
    isFirstData = True
    currentNum = ""
    
    For i = 1 To Len(temp)
        ch = Mid$(temp, i, 1)
        
        If IsNumeric(ch) Then
            currentNum = currentNum & ch
        Else
            If Len(currentNum) > 0 Then
                If currentNum = "0" And (ch = "년" Or ch = "월" Or ch = "일") Then
                    If Mid$(temp, i + 1, 1) = " " Then i = i + 1
                Else
                    If isFirstData Then
                        result = result & " " & currentNum & ch
                        isFirstData = False
                    Else
                        result = result & currentNum & ch
                    End If
                End If
                currentNum = ""
            Else
                result = result & ch
            End If
        End If
    Next i
    
    Do While InStr(result, "  ") > 0
        result = Replace(result, "  ", " ")
    Loop
    
    NormalizeSentenceTerm = Trim$(result)
End Function

Private Function CombineValues(ByVal firstValue As String, ByVal secondValue As String) As String
    If Len(firstValue) > 0 And Len(secondValue) > 0 Then
        CombineValues = firstValue & "/" & secondValue
    ElseIf Len(firstValue) > 0 Then
        CombineValues = firstValue
    Else
        CombineValues = secondValue
    End If
End Function

Private Function NormalizeRepeatCount(ByVal value As String) As String
    value = Trim$(value)
    If Len(value) = 0 Then Exit Function

    Do While Right$(value, 1) = "범"
        value = Trim$(Left$(value, Len(value) - 1))
    Loop

    If Len(value) > 0 Then NormalizeRepeatCount = value & "범"
End Function

Private Function ValueOrPending(ByVal value As String) As String
    value = Trim$(value)
    If Len(value) = 0 Then value = "미결"
    ValueOrPending = value
End Function

Private Function NormalizeSecurityClass(ByVal rawValue As String) As String
    Dim i As Long, ch As String, numPart As String
    rawValue = Trim$(rawValue)
    If Len(rawValue) = 0 Then NormalizeSecurityClass = "미결": Exit Function
    
    For i = 1 To Len(rawValue)
        ch = Mid$(rawValue, i, 1)
        If IsNumeric(ch) Then
            numPart = numPart & ch
        ElseIf Len(numPart) > 0 Then
            Exit For
        End If
    Next i
    
    If Len(numPart) = 0 Then NormalizeSecurityClass = "미결": Exit Function
    NormalizeSecurityClass = "S" & numPart
    If InStr(1, rawValue, "대우", vbTextCompare) > 0 Then NormalizeSecurityClass = NormalizeSecurityClass & "대우"
End Function

Private Function ParseNumbers(ByVal rawNumbers As String) As Collection
    Dim result As Collection, parts As Variant, item As Variant, value As String
    Set result = New Collection
    
    rawNumbers = Replace(rawNumbers, vbCrLf, ","): rawNumbers = Replace(rawNumbers, vbCr, ","): rawNumbers = Replace(rawNumbers, vbLf, ","): rawNumbers = Replace(rawNumbers, ";", ",")
    parts = Split(rawNumbers, ",")
    
    On Error Resume Next 
    For Each item In parts
        value = Trim$(CStr(item))
        If Len(value) > 0 Then result.Add value, value
    Next item
    On Error GoTo 0
    Set ParseNumbers = result
End Function

Private Function FindTemplateTables(ByVal doc As Document, ByRef personTableIndex As Long, ByRef violationTableIndex As Long) As Boolean
    Dim index As Long, currentTable As Table
    personTableIndex = 0: violationTableIndex = 0
    For index = 1 To doc.Tables.Count
        Set currentTable = doc.Tables(index)
        If personTableIndex = 0 Then
            If TableHasHeader(currentTable, "번호") And TableHasHeader(currentTable, "성명") And TableHasHeader(currentTable, "죄명") And TableHasHeader(currentTable, "형명형기") And TableHasHeader(currentTable, "형기종료일") Then personTableIndex = index
        End If
        If violationTableIndex = 0 Then
            If TableHasHeader(currentTable, "위반일시") And TableHasHeader(currentTable, "관규위반내용") And TableHasHeader(currentTable, "보고자") And TableHasHeader(currentTable, "확인자") And TableHasHeader(currentTable, "비고") Then violationTableIndex = index
        End If
    Next index
    FindTemplateTables = (personTableIndex > 0 And violationTableIndex > 0)
End Function

Private Function TableHasHeader(ByVal targetTable As Table, ByVal canonicalName As String) As Boolean
    TableHasHeader = (HeaderColumn(targetTable, canonicalName) > 0)
End Function

Private Function HeaderColumn(ByVal targetTable As Table, ByVal canonicalName As String) As Long
    Dim colNum As Long, headerName As String
    On Error GoTo Done
    For colNum = 1 To targetTable.Columns.Count
        headerName = CanonicalHeader(CellValue(targetTable.Cell(1, colNum)))
        If headerName = canonicalName Then HeaderColumn = colNum: Exit Function
    Next colNum
Done:
End Function

Private Function CanonicalHeader(ByVal rawHeader As String) As String
    Dim normalized As String
    normalized = NormalizeHeader(rawHeader)
    Select Case normalized
        Case "번호", "수용번호", "수번": CanonicalHeader = "번호"
        Case "성명", "이름": CanonicalHeader = "성명"
        Case "죄명": CanonicalHeader = "죄명"
        Case "형명형기", "형명및형기": CanonicalHeader = "형명형기"
        Case "범수": CanonicalHeader = "범수"
        Case "경비급", "경비처우급", "처우급": CanonicalHeader = "경비처우급"
        Case "범수경비급", "범수경비처우급", "범수및경비급", "범수및경비처우급": CanonicalHeader = "범수경비처우급"
        Case "형기종료일", "형기종료", "종료일": CanonicalHeader = "형기종료일"
        Case "위반일시", "규율위반일시": CanonicalHeader = "위반일시"
        Case "관규위반내용", "규율위반내용", "위반내용": CanonicalHeader = "관규위반내용"
        Case "보고자", "보고직원": CanonicalHeader = "보고자"
        Case "확인자", "확인직원": CanonicalHeader = "확인자"
        Case "비고": CanonicalHeader = "비고"
        Case Else: CanonicalHeader = ""
    End Select
End Function

Private Function NormalizeHeader(ByVal value As String) As String
    value = LCase$(Trim$(value)): value = Replace(value, " ", ""): value = Replace(value, vbTab, ""): value = Replace(value, vbCr, ""): value = Replace(value, vbLf, ""): value = Replace(value, "/", ""): value = Replace(value, "\", ""): value = Replace(value, "·", ""): value = Replace(value, "-", ""): value = Replace(value, "_", ""): value = Replace(value, "(", ""): value = Replace(value, ")", ""): NormalizeHeader = value
End Function

' ★ 여기서부터가 저번 답변에서 잘렸던 핵심 도우미 함수들입니다!
Private Sub FillPersonTable(ByVal targetTable As Table, ByVal record As Variant)
    Dim endDate As String
    endDate = NormalizeEndDate(CStr(record(7)))
    If Len(endDate) = 0 Then endDate = "미결"
    SetByHeader targetTable, "번호", CStr(record(0))
    SetByHeader targetTable, "성명", CStr(record(1))
    SetByHeader targetTable, "죄명", CStr(record(2))
    SetByHeader targetTable, "형명형기", NormalizeSentenceTerm(CStr(record(3)))
    SetByHeader targetTable, "범수", CStr(record(5))
    SetByHeader targetTable, "경비처우급", CStr(record(4))
    SetByHeader targetTable, "범수경비처우급", CStr(record(6))
    SetByHeader targetTable, "형기종료일", endDate
End Sub

Private Sub FillViolationTable(ByVal targetTable As Table, ByVal record As Variant)
    Dim vDate As String
    vDate = NormalizeTableLines(Trim$(CStr(record(8))))
    SetByHeader targetTable, "위반일시", vDate
    SetByHeader targetTable, "관규위반내용", CStr(record(9))
    SetByHeader targetTable, "보고자", NormalizeTableLines(CStr(record(10)))
    SetByHeader targetTable, "확인자", CStr(record(11))
    SetByHeader targetTable, "비고", CStr(record(12))
End Sub

Private Function NormalizeTableLines(ByVal value As String) As String
    value = Replace(value, vbCrLf, vbCr)
    value = Replace(value, vbLf, vbCr)
    NormalizeTableLines = value
End Function

Private Sub SetByHeader(ByVal targetTable As Table, ByVal canonicalName As String, ByVal value As String)
    Dim colNum As Long
    colNum = HeaderColumn(targetTable, canonicalName)
    If colNum = 0 Then Exit Sub
    If targetTable.Rows.Count < 2 Then Exit Sub
    SetCellText targetTable.Cell(2, colNum), value
End Sub

Private Sub ClearTableRows(ByVal targetTable As Table, ByVal firstRow As Long)
    Dim rowNum As Long, colNum As Long
    On Error Resume Next
    For rowNum = firstRow To targetTable.Rows.Count
        For colNum = 1 To targetTable.Columns.Count
            SetCellText targetTable.Cell(rowNum, colNum), ""
        Next colNum
    Next rowNum
    On Error GoTo 0
End Sub

Private Function CellValue(ByVal targetCell As Cell) As String
    Dim targetRange As Range
    Set targetRange = targetCell.Range.Duplicate
    targetRange.End = targetRange.End - 1
    CellValue = targetRange.Text
End Function

Private Sub SetCellText(ByVal targetCell As Cell, ByVal value As String)
    Dim targetRange As Range
    Set targetRange = targetCell.Range.Duplicate
    targetRange.End = targetRange.End - 1
    targetRange.Text = value
End Sub

Private Sub CopyPageSetup(ByVal sourceDoc As Document, ByVal targetDoc As Document)
    With targetDoc.Sections(1).PageSetup
        .Orientation = sourceDoc.Sections(1).PageSetup.Orientation
        .PageWidth = sourceDoc.Sections(1).PageSetup.PageWidth
        .PageHeight = sourceDoc.Sections(1).PageSetup.PageHeight
        .TopMargin = sourceDoc.Sections(1).PageSetup.TopMargin
        .BottomMargin = sourceDoc.Sections(1).PageSetup.BottomMargin
        .LeftMargin = sourceDoc.Sections(1).PageSetup.LeftMargin
        .RightMargin = sourceDoc.Sections(1).PageSetup.RightMargin
        .HeaderDistance = sourceDoc.Sections(1).PageSetup.HeaderDistance
        .FooterDistance = sourceDoc.Sections(1).PageSetup.FooterDistance
    End With
End Sub

Private Function FolderExists(ByVal folderPath As String) As Boolean
    Dim path As String
    On Error Resume Next
    path = Trim$(folderPath)
    If Len(path) > 0 And Right$(path, 1) = "\" Then path = Left$(path, Len(path) - 1)
    If Len(path) = 0 Then FolderExists = False: Exit Function
    FolderExists = ((GetAttr(path) And vbDirectory) = vbDirectory)
    On Error GoTo 0
End Function

Private Function NextAvailableOutputPath(ByVal folderPath As String, ByVal record As Variant) As String
    Dim basePath As String, candidate As String, suffix As Long
    Dim dateTimePart As String, numberPart As String, namePart As String

    dateTimePart = FileDateTimeToken(CStr(record(8)))
    numberPart = SafeFilePart(CStr(record(0)), "번호없음")
    namePart = SafeFilePart(CStr(record(1)), "성명없음")

    basePath = AddTrailingSlash(folderPath) & "스티커 " & numberPart & " " & namePart & " " & dateTimePart

    candidate = basePath & ".docx"
    suffix = 1
    Do While Len(Dir$(candidate)) > 0
        candidate = basePath & " (" & CStr(suffix) & ").docx"
        suffix = suffix + 1
    Loop
    NextAvailableOutputPath = candidate
End Function

Private Function FileDateTimeToken(ByVal value As String) As String
    Dim i As Long, ch As String, numStr As String

    For i = 1 To Len(value)
        ch = Mid$(value, i, 1)
        If IsNumeric(ch) Then numStr = numStr & ch
    Next i

    If Len(numStr) >= 10 Then
        FileDateTimeToken = Left$(numStr, 10)
    ElseIf Len(numStr) > 0 Then
        FileDateTimeToken = numStr
    Else
        FileDateTimeToken = Format$(Now, "yymmddhhnn")
    End If
End Function

Private Function SafeFilePart(ByVal value As String, ByVal fallbackValue As String) As String
    Dim invalidChars As Variant, item As Variant

    value = Trim$(value)
    invalidChars = Array("\", "/", ":", "*", "?", """", "<", ">", "|")
    For Each item In invalidChars
        value = Replace(value, CStr(item), "_")
    Next item

    Do While Len(value) > 0 And (Right$(value, 1) = "." Or Right$(value, 1) = " ")
        value = Left$(value, Len(value) - 1)
    Loop

    If Len(value) = 0 Then value = fallbackValue
    SafeFilePart = value
End Function

Private Function AddTrailingSlash(ByVal folderPath As String) As String
    folderPath = Trim$(folderPath)
    If Len(folderPath) > 0 Then
        If Right$(folderPath, 1) <> "\" Then folderPath = folderPath & "\"
    End If
    AddTrailingSlash = folderPath
End Function