Option Explicit

Private Const wdFormatXMLDocument As Long = 12
Private Const msoFileDialogFilePicker As Long = 3
Private Const msoFileDialogFolderPicker As Long = 4

Public gQueue As Collection
Private gExcelApp As Object
Private gWorkbook As Object
Private gWorkbookPath 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 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
    If Len(Trim$(violationDate)) = 0 Then resultMessage = "위반일시를 입력해 주세요.": Exit Function
    If Len(Trim$(violationContent)) = 0 Then resultMessage = "관규위반내용을 입력해 주세요.": Exit Function
    If Len(Trim$(reporter)) = 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 Len(Trim$(violationDate)) = 0 Then resultMessage = "위반일시를 입력해 주세요.": Exit Function
    If Len(Trim$(violationContent)) = 0 Then resultMessage = "관규위반내용을 입력해 주세요.": Exit Function
    If Len(Trim$(reporter)) = 0 Then resultMessage = "보고자를 입력해 주세요.": Exit Function

    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))), _
        ShortenYearText(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

Public Sub CloseDataWorkbook()
    On Error Resume Next
    If Not gWorkbook Is Nothing Then gWorkbook.Close False
    If Not gExcelApp Is Nothing Then gExcelApp.Quit
    Set gWorkbook = Nothing
    Set gExcelApp = Nothing
    gWorkbookPath = ""
    On Error GoTo 0
End Sub

Private Function LookupPerson(ByVal excelPath As String, ByVal personNumber As String, ByRef person As Variant, ByRef resultMessage As String) As Boolean
    Dim ws As Object, rowNum As Long, lastRow As Long, targetNumber As String, currentNumber As String
    Dim securityClass As String, repeatCount As String, combinedClass As String

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

    For Each ws In gWorkbook.Worksheets
        If ws.Visible = -1 Then
            lastRow = ws.Cells(ws.Rows.Count, 3).End(-4162).Row
            If lastRow < 1 Then lastRow = 1
            For rowNum = 1 To lastRow
                currentNumber = NormalizeIdentifier(CellText(ws, rowNum, 3))
                If currentNumber = targetNumber Then
                    securityClass = NormalizeSecurityClass(CellText(ws, rowNum, 12))
                    repeatCount = NormalizeRepeatCount(CellText(ws, rowNum, 13))
                    combinedClass = CombineValues(repeatCount, securityClass)
                    person = Array(CellText(ws, rowNum, 3), CellText(ws, rowNum, 4), CellText(ws, rowNum, 14), ValueOrPending(CellText(ws, rowNum, 15)), securityClass, repeatCount, combinedClass, CellText(ws, rowNum, 17))
                    resultMessage = "조회 완료": LookupPerson = True: Exit Function
                End If
            Next rowNum
        End If
    Next ws
    resultMessage = "엑셀 C열에서 번호를 찾지 못했습니다."
    Exit Function
Fail:
    resultMessage = "엑셀 조회 오류: " & Err.Description
End Function

Private Function EnsureWorkbook(ByVal excelPath As String, ByRef resultMessage As String) As Boolean
    On Error GoTo Fail
    If Len(Dir$(excelPath)) = 0 Then resultMessage = "선택한 엑셀 파일을 찾을 수 없습니다.": Exit Function
    If Not gWorkbook Is Nothing Then
        If StrComp(gWorkbookPath, excelPath, vbTextCompare) = 0 Then EnsureWorkbook = True: Exit Function
    End If
    CloseDataWorkbook
    Set gExcelApp = CreateObject("Excel.Application")
    gExcelApp.Visible = False
    gExcelApp.DisplayAlerts = False
    Set gWorkbook = gExcelApp.Workbooks.Open(excelPath, 0, True)
    gWorkbookPath = excelPath
    EnsureWorkbook = True
    Exit Function
Fail:
    CloseDataWorkbook
    resultMessage = "엑셀 파일을 열 수 없습니다: " & Err.Description
End Function

Private Function CellText(ByVal ws As Object, ByVal rowNum As Long, ByVal colNum As Long) As String
    Dim result As String, rawValue As Variant
    On Error Resume Next
    result = Trim$(CStr(ws.Cells(rowNum, colNum).Text))
    rawValue = ws.Cells(rowNum, colNum).value
    On Error GoTo 0
    If Len(result) > 0 And Len(Replace(result, "#", "")) = 0 Then
        If IsDate(rawValue) Then result = Format$(CDate(rawValue), "yyyy.mm.dd") Else result = Trim$(CStr(rawValue))
    End If
    CellText = result
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 regex As Object
    Set regex = CreateObject("VBScript.RegExp")
    regex.Global = True
    regex.IgnoreCase = True
    regex.Pattern = "(18|19|20|21)([0-9]{2})"
    ShortenYearText = regex.Replace(value, "$2")
End Function

Private Function NormalizeEndDate(ByVal value As String) As String
    Dim regex As Object, matches As Object, target As Object
    Dim yearPart As String, monthPart As String, dayPart As String
    Dim prefix As String, suffix As String

    value = Trim$(value)
    If Len(value) = 0 Then Exit Function

    Set regex = CreateObject("VBScript.RegExp")
    regex.Global = False
    regex.IgnoreCase = True
    regex.Pattern = "([0-9]{2,4})\s*[-./]\s*([0-9]{1,2})\s*[-./]\s*([0-9]{1,2})"
    Set matches = regex.Execute(value)

    If matches.Count = 0 Then
        NormalizeEndDate = ShortenYearText(value)
        Exit Function
    End If

    Set target = matches(0)
    yearPart = CStr(target.SubMatches(0))
    If Len(yearPart) = 4 Then yearPart = Right$(yearPart, 2)
    monthPart = Right$("0" & CStr(CLng(target.SubMatches(1))), 2)
    dayPart = Right$("0" & CStr(CLng(target.SubMatches(2))), 2)

    prefix = Left$(value, target.FirstIndex)
    suffix = Mid$(value, target.FirstIndex + target.Length + 1)
    NormalizeEndDate = Trim$(prefix & yearPart & "." & monthPart & "." & dayPart & suffix)
End Function

Private Function NormalizeSentenceTerm(ByVal value As String) As String
    Dim regex As Object

    value = Trim$(ShortenYearText(value))
    If Len(value) = 0 Then Exit Function

    Set regex = CreateObject("VBScript.RegExp")
    regex.Global = True
    regex.IgnoreCase = True

    ' 기간 단위 사이를 먼저 띄워 연속된 0 단위도 안전하게 구분합니다.
    regex.Pattern = "([0-9]+)\s*(년|월|일)\s*"
    value = regex.Replace(value, "$1$2 ")

    ' 숫자 경계가 있는 0년, 0월, 0일만 제거합니다.
    regex.Pattern = "(^|[^0-9])0+\s*(년|월|일)"
    value = regex.Replace(value, "$1")

    regex.Pattern = "\s+"
    value = regex.Replace(value, " ")
    NormalizeSentenceTerm = Trim$(value)
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 regex As Object, matches As Object, numberPart As String
    rawValue = Trim$(rawValue)
    If Len(rawValue) = 0 Then NormalizeSecurityClass = "미결": Exit Function
    Set regex = CreateObject("VBScript.RegExp")
    regex.Global = False: regex.IgnoreCase = True
    regex.Pattern = "S\s*([0-9]+)"
    Set matches = regex.Execute(rawValue)
    If matches.Count = 0 Then regex.Pattern = "([0-9]+)": Set matches = regex.Execute(rawValue)
    If matches.Count = 0 Then NormalizeSecurityClass = "미결": Exit Function
    numberPart = CStr(matches(0).SubMatches(0))
    NormalizeSecurityClass = "S" & numberPart
    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, seen As Object
    Set result = New Collection
    Set seen = CreateObject("Scripting.Dictionary")
    rawNumbers = Replace(rawNumbers, vbCrLf, ","): rawNumbers = Replace(rawNumbers, vbCr, ","): rawNumbers = Replace(rawNumbers, vbLf, ","): rawNumbers = Replace(rawNumbers, ";", ",")
    parts = Split(rawNumbers, ",")
    For Each item In parts
        value = Trim$(CStr(item))
        If Len(value) > 0 Then
            If Not seen.Exists(LCase$(value)) Then seen.Add LCase$(value), True: result.Add value
        End If
    Next item
    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(ShortenYearText(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 fileSystem As Object
    Set fileSystem = CreateObject("Scripting.FileSystemObject")
    FolderExists = fileSystem.FolderExists(Trim$(folderPath))
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 datePart As String, numberPart As String, namePart As String

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

    basePath = AddTrailingSlash(folderPath) & "규율위반자_개인별_명부_" & _
               datePart & "_" & numberPart & "_" & namePart

    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 FileDateToken(ByVal value As String) As String
    Dim regex As Object, matches As Object
    Dim yearPart As String, monthPart As String, dayPart As String

    Set regex = CreateObject("VBScript.RegExp")
    regex.Global = False
    regex.IgnoreCase = True
    regex.Pattern = "([0-9]{2,4})[^0-9]+([0-9]{1,2})[^0-9]+([0-9]{1,2})"
    Set matches = regex.Execute(value)

    If matches.Count = 0 Then
        FileDateToken = Format$(Now, "yymmdd")
        Exit Function
    End If

    yearPart = CStr(matches(0).SubMatches(0))
    If Len(yearPart) = 4 Then yearPart = Right$(yearPart, 2)
    monthPart = Right$("0" & CStr(matches(0).SubMatches(1)), 2)
    dayPart = Right$("0" & CStr(matches(0).SubMatches(2)), 2)
    FileDateToken = Right$("0" & yearPart, 2) & monthPart & dayPart
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