'-----------------------------------------------------------------------------
' 主过程：同步修改记录到数据库
'-----------------------------------------------------------------------------
Public Sub SyncModifiedDatesToAccess()
    Dim ws As Worksheet
    Dim lastRow As Long, r As Long
    Dim modifiedCount As Long

    Dim conn As Object, rs As Object
    Dim connStr As String, strSQL As String

    Dim dbPath As String
    Dim tableName As String
    dbPath = "\\192.168.110.114\生产进度表\2026年数据\执行卡下发记录.accdb"
    tableName = "货期修改记录"

    Set ws = ThisWorkbook.Worksheets("货期检查")
    lastRow = ws.Cells(ws.Rows.count, 1).End(xlUp).Row
    If lastRow < 4 Then Exit Sub

    On Error GoTo ErrorHandler
    Set conn = CreateObject("ADODB.Connection")

    connStr = "Driver={Microsoft Access Driver (*.mdb, *.accdb)};Dbq=" & dbPath & ";Uid=Admin;Pwd=;"
    conn.Open connStr

    Set rs = CreateObject("ADODB.Recordset")
    modifiedCount = 0

    Application.ScreenUpdating = False

    For r = 4 To lastRow
        ' ★ 第11列为“修正交货日期”
        If Trim(CStr(ws.Cells(r, 11).Value)) <> "" Then
            Dim pcNo As String, seqNo As String

            ' ★ 排产号(现为第2列)，序号(现为第3列)
            pcNo = Replace(Trim(CStr(ws.Cells(r, 2).Value)), "'", "''")
            seqNo = Trim(CStr(ws.Cells(r, 3).Value))

            If pcNo <> "" And seqNo <> "" And IsNumeric(seqNo) Then
                strSQL = "SELECT * FROM " & tableName & " WHERE [排产号]='" & pcNo & "' AND [序号]=" & seqNo

                rs.Open strSQL, conn, 1, 3

                If rs.EOF Then
                    rs.AddNew
                    rs.Fields("排产号").Value = ws.Cells(r, 2).Value
                    rs.Fields("序号").Value = ws.Cells(r, 3).Value
                End If

                ' ★ 增加写入销售合同号（需确保数据库中有该字段，若无请注释此行）
                rs.Fields("销售合同号").Value = ws.Cells(r, 1).Value

                ' ★ 以下全部偏移1列
                rs.Fields("产品名称").Value = ws.Cells(r, 4).Value
                rs.Fields("技术参数").Value = ws.Cells(r, 5).Value
                rs.Fields("型号").Value = ws.Cells(r, 6).Value
                rs.Fields("业务员").Value = ws.Cells(r, 7).Value

                If IsNumeric(ws.Cells(r, 8).Value) And Not IsEmpty(ws.Cells(r, 8).Value) Then
                    rs.Fields("数量").Value = ws.Cells(r, 8).Value
                Else
                    rs.Fields("数量").Value = 0
                End If

                If IsDate(ws.Cells(r, 9).Value) Then rs.Fields("签订日期").Value = CDate(ws.Cells(r, 9).Value)
                If IsDate(ws.Cells(r, 10).Value) Then rs.Fields("交货日期").Value = CDate(ws.Cells(r, 10).Value)
                If IsDate(ws.Cells(r, 11).Value) Then rs.Fields("修正交货日期").Value = CDate(ws.Cells(r, 11).Value)

                rs.Fields("产品分类").Value = ws.Cells(r, 12).Value

                If IsNumeric(ws.Cells(r, 13).Value) Then rs.Fields("BIP货期").Value = ws.Cells(r, 13).Value
                If IsNumeric(ws.Cells(r, 14).Value) Then rs.Fields("BIP货期_工作日").Value = ws.Cells(r, 14).Value
                If IsNumeric(ws.Cells(r, 15).Value) Then rs.Fields("工厂货期_工作日").Value = ws.Cells(r, 15).Value

                rs.Fields("添加记录的时间").Value = Now

                rs.Update
                rs.Close

                modifiedCount = modifiedCount + 1
            End If
        End If
    Next r

    conn.Close
    Set rs = Nothing
    Set conn = Nothing
    Application.ScreenUpdating = True

    If modifiedCount > 0 Then
        MsgBox "同步成功！共更新/新增了 " & modifiedCount & " 条货期修改记录。", vbInformation
    Else
        MsgBox "没有发现填写了【修正交货日期】的有效记录，未执行任何同步。", vbInformation
    End If
    Exit Sub

ErrorHandler:
    Dim errNum As Long, errDesc As String
    errNum = Err.Number: errDesc = Err.Description
    Application.ScreenUpdating = True

    On Error Resume Next
    If Not rs Is Nothing Then
        If rs.State = 1 Then
            If rs.EditMode <> 0 Then rs.CancelUpdate
            rs.Close
        End If
    End If
    If Not conn Is Nothing Then
        If conn.State = 1 Then conn.Close
    End If
    On Error GoTo 0

    MsgBox "同步到数据库时发生错误！" & vbCrLf & _
           "错误编号: " & errNum & vbCrLf & _
           "错误描述: " & errDesc, vbCritical
End Sub