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
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 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

    If Len(Trim$(excelPath)) = 0 Then resultMessage = "먼저 엑셀 파일을 선택해 주세요.": Exit Function
    If Len(Dir$(excelPath)) = 0 Then resultMessage = "선택한 엑셀 파일을 찾을 수 없습니다.": Exit Function
    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

    If Len(Trim$(excelPath)) = 0 Then resultMessage = "먼저 엑셀 파일을 선택해 주세요.": Exit Function
    If Len(Dir$(excelPath)) = 0 Then resultMessage = "선택한 엑셀 파일을 찾을 수 없습니다.": Exit Function

    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
    Dim record As Variant, index As Long
    Dim fillMessage As String, errorText As String
    Dim 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
    If Len(createdPaths) > 0 Then
        resultMessage = resultMessage & vbCrLf & vbCrLf & "오류 전에 생성된 파일:" & vbCrLf & createdPaths
    End If
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
    Dim record As Variant, index As Long
    Dim fillMessage As String, errorText As String
    Dim 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
    If Len(createdPaths) > 0 Then
        resultMessage = resultMessage & vbCrLf & vbCrLf & "오류 전에 생성된 파일:" & vbCrLf & createdPaths
    End If
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
    Dim 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
    Dim 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 dataSource As Object
    Dim recordIndex As Long, recordCount As Long, previousRecord As Long
    Dim targetNumber As String, currentNumber As String
    Dim securityClass As String, repeatCount As String, combinedClass As String

    On Error GoTo Fail
    If Not EnsureWordDataSource(excelPath, resultMessage) Then Exit Function
    targetNumber = NormalizeIdentifier(personNumber)
    If Len(targetNumber) = 0 Then resultMessage = "번호가 비어 있습니다.": Exit Function

    Set dataSource = ActiveDocument.MailMerge.DataSource
    
    On Error Resume Next
    Dim checkCols As Long
    checkCols = dataSource.DataFields.Count
    On Error GoTo Fail
    If checkCols < 17 Then
        resultMessage = "엑셀 표 구조 인식 실패: 1행의 거대한 병합 셀 때문에 워드가 전체 열(Q열)을 읽지 못했습니다." & vbCrLf & _
                        "★ 해결법: 원본 엑셀 파일을 열고 표 윗부분(1~5행)을 삭제하여 '번호, 성명...' 제목이 1행에 오도록 저장한 후 다시 선택해 주세요."
        Exit Function
    End If

    recordCount = WordDataRecordCount(dataSource)
    If recordCount = 0 Then resultMessage = "Word 데이터 연결에서 조회할 레코드를 찾지 못했습니다.": Exit Function

    dataSource.ActiveRecord = wdFirstRecord
    For recordIndex = 1 To recordCount
        If dataSource.ActiveRecord = wdNoActiveRecord Then Exit For

        currentNumber = NormalizeIdentifier(WordDataFieldText(dataSource, 3))
        If currentNumber = targetNumber 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))
            resultMessage = "조회 완료": LookupPerson = True: Exit Function
        End If

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

    resultMessage = "Word 데이터 연결에서 번호를 찾지 못했습니다."
    Exit Function
Fail:
    resultMessage = "Word 데이터 연결 조회 오류: " & Err.Description
End Function

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

    If StrComp(gDataSourcePath, excelPath, vbTextCompare) = 0 Then
        EnsureWordDataSource = True
        Exit Function
    End If

    CloseDataConnection

    With ActiveDocument.MailMerge
        .MainDocumentType = wdFormLetters
        .OpenDataSource Name:=excelPath, _
                        ConfirmConversions:=False, _
                        ReadOnly:=True, _
                        LinkToSource:=False, _
                        AddToRecentFiles:=False
    End With

    gDataSourcePath = excelPath
    EnsureWordDataSource = True
    Exit Function
Fail:
    CloseDataConnection
    resultMessage = "Word 메일 병합 기능으로 엑셀 파일을 연결할 수 없습니다: " & Err.Description
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

Private Function NormalizeSentenceTerm(ByVal value As String) As String
    Dim temp As String, result As String
    Dim i As Long, ch As String
    Dim hasSpaceAdded As Boolean
    
    temp = Trim$(value)
    temp = Replace(temp, " ", "")
    
    For i = 1 To Len(temp)
        ch = Mid$(temp, i, 1)
        If IsNumeric(ch) And Not hasSpaceAdded Then
            result = result & " " & ch
            hasSpaceAdded = True
        Else
            result = result & ch
        End If
    Next i
    
    temp = result
    
    temp = Replace(temp, "0년", "")
    temp = Replace(temp, "0월", "")
    temp = Replace(temp, "0일", "")
    
    temp = Replace(temp, "년", "년 ")
    temp = Replace(temp, "월", "월 ")
    temp = Replace(temp, "일", "일 ")
    
    Do While InStr(temp, "  ") > 0
        temp = Replace(temp, "  ", " ")
    Loop
    
    NormalizeSentenceTerm = Trim$(temp)
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

' ★★★ [업그레이드] 스티커 1127 소언수 2605011856 형식 조합 ★★★
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)), "성명없음")

    ' 스티커 번호 성명 연월일시분 (예: 스티커 1127 홍길동 2605011856)
    basePath = AddTrailingSlash(folderPath) & "스티커 " & numberPart & " " & namePart & " " & dateTimePart

    candidate = basePath & ".docx"
    suffix = 1
    Do While Len(Dir$(candidate)) > 0
        candidate = basePath & " (" & CStr(suffix) & ").docx" ' 파일명이 겹치면 뒤에 (1) 붙임
        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) ' 딱 yymmddhhmm (10자리)만 맞춤
    ElseIf Len(numStr) > 0 Then
        FileDateTimeToken = numStr ' 숫자가 10자리가 안되면 일단 있는 숫자라도 반환
    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