'=============================================================================
' 模块：数据存档模块
' 功能：将[货期检查]中“修正交货日期”不为空的数据，追加到存档工作簿中
'=============================================================================
Option Explicit

'-----------------------------------------------------------------------------
' 主过程：归档已修正货期的数据
'-----------------------------------------------------------------------------
Public Sub ArchiveModifiedData()
    Dim wsSrc As Worksheet
    Dim srcLastRow As Long

    Dim tgtFilePath As String
    Dim wbTgt As Workbook
    Dim wsTgt As Worksheet
    Dim tgtLastRow As Long

    Dim srcData As Variant
    Dim outData() As Variant
    Dim r As Long, c As Long
    Dim validCount As Long

    Set wsSrc = ThisWorkbook.Worksheets("货期检查")
    srcLastRow = wsSrc.Cells(wsSrc.Rows.count, 1).End(xlUp).Row

    If srcLastRow < 4 Then
        MsgBox "没有数据可以存档！", vbExclamation
        Exit Sub
    End If

    tgtFilePath = ThisWorkbook.Path & "\常规产品生产周期_总表.xlsx"

    If Dir(tgtFilePath) = "" Then
        MsgBox "找不到存档文件，请确认该文件是否与当前表格在同一目录下：" & vbCrLf & tgtFilePath, vbCritical
        Exit Sub
    End If

    ' ★ 将源数据第4行到最后一行的1至17列（增加了一列）读入内存数组
    srcData = wsSrc.Range(wsSrc.Cells(4, 1), wsSrc.Cells(srcLastRow, 17)).Value

    ' ★ 准备输出数组，共 18 列（17列基础数据 + 1列处理日期）
    ReDim outData(1 To UBound(srcData, 1), 1 To 18)
    validCount = 0

    For r = 1 To UBound(srcData, 1)
        ' ★ 第11列为“修正交货日期”
        If Trim(CStr(srcData(r, 11))) <> "" Then
            validCount = validCount + 1

            ' 复制前17列数据
            For c = 1 To 17
                outData(validCount, c) = srcData(r, c)
            Next c

            ' 第18列写入今天的日期
            outData(validCount, 18) = Date
        End If
    Next r

    If validCount = 0 Then
        MsgBox "未发现填有【修正交货日期】的数据，无需存档。", vbInformation
        Exit Sub
    End If

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    On Error GoTo ErrorHandler

    Set wbTgt = Workbooks.Open(Filename:=tgtFilePath, UpdateLinks:=False)
    Set wsTgt = wbTgt.Worksheets("总表")

    tgtLastRow = wsTgt.Cells(wsTgt.Rows.count, 1).End(xlUp).Row

    ' ★ 写入区域宽度改为 18 列
    wsTgt.Range(wsTgt.Cells(tgtLastRow + 1, 1), wsTgt.Cells(tgtLastRow + validCount, 18)).Value = outData

    wbTgt.Close SaveChanges:=True

    Application.DisplayAlerts = True
    Application.ScreenUpdating = True

    MsgBox "存档成功！共将 " & validCount & " 条修改记录追加到了总表中。", vbInformation
    Exit Sub

ErrorHandler:
    Dim errDesc As String
    errDesc = Err.Description

    Application.DisplayAlerts = True
    Application.ScreenUpdating = True

    On Error Resume Next
    If Not wbTgt Is Nothing Then wbTgt.Close SaveChanges:=False
    On Error GoTo 0

    MsgBox "存档过程中发生错误：" & vbCrLf & errDesc, vbCritical
End Sub