'=============================================================================
' 临时排查脚本：精准定位“数据类型不匹配 (-2147217913)” 发生的具体位置
'=============================================================================
Sub DebugTypeMismatch()
    Dim ws As Worksheet
    Dim r As Long, lastRow As Long, testRow As Long
    Dim conn As Object, rs As Object
    Dim dbPath As String, connStr As String, strSQL As String
    Dim pcNo As String, seqNo As String

    dbPath = "\\192.168.110.114\生产进度表\2026年数据\执行卡下发记录.accdb"
    connStr = "Driver={Microsoft Access Driver (*.mdb, *.accdb)};Dbq=" & dbPath & ";Uid=Admin;Pwd=;"

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

    ' 1. 找到第一行有【修正交货日期】的数据进行测试
    testRow = 0
    For r = 4 To lastRow
        If Trim(CStr(ws.Cells(r, 10).Value)) <> "" Then
            testRow = r
            Exit For
        End If
    Next r

    If testRow = 0 Then
        MsgBox "没有找到填写了【修正交货日期】的数据，无法进行测试！", vbExclamation
        Exit Sub
    End If

    Set conn = CreateObject("ADODB.Connection")
    On Error Resume Next
    conn.Open connStr
    If Err.Number <> 0 Then
        MsgBox "连接数据库失败，错误: " & Err.Description, vbCritical
        Exit Sub
    End If
    On Error GoTo 0

    pcNo = Replace(Trim(CStr(ws.Cells(testRow, 1).Value)), "'", "''")
    seqNo = Replace(Trim(CStr(ws.Cells(testRow, 2).Value)), "'", "''")

    ' ==========================================
    ' 第一关：测试 SQL 查询语句
    ' ==========================================
    strSQL = "SELECT * FROM 货期修改记录 WHERE [排产号]='" & pcNo & "' AND [序号]='" & seqNo & "'"
    Set rs = CreateObject("ADODB.Recordset")

    On Error Resume Next
    rs.Open strSQL, conn, 1, 3
    If Err.Number <> 0 Then
        Dim sqlErr As String
        sqlErr = Err.Description
        On Error GoTo 0
        MsgBox "?? 抓到内鬼了！（在查询阶段报错）" & vbCrLf & vbCrLf & _
               "在执行判断是否存在旧记录的 SQL 语句时发生了类型不匹配！" & vbCrLf & _
               "?? 原因极大概率是：Access 数据库中的【序号】（或排产号）被设置为了“数字”类型，" & vbCrLf & _
               "而代码里加上了单引号把它们当“文本”去查了。" & vbCrLf & vbCrLf & _
               "系统原始报错：" & sqlErr, vbCritical

        If conn.State = 1 Then conn.Close
        Exit Sub
    End If
    On Error GoTo 0

    ' ==========================================
    ' 第二关：测试各字段逐个赋值
    ' ==========================================
    If rs.EOF Then rs.AddNew

    Dim fieldsToTest As Variant
    Dim colsToTest As Variant
    Dim i As Integer
    Dim fName As String, fVal As Variant

    ' 准备要测试的字段名和对应的 Excel 列号
    fieldsToTest = Array("排产号", "序号", "产品名称", "技术参数", "型号", "业务员", "数量", "签订日期", "交货日期", "修正交货日期", "产品分类", "BIP货期", "BIP货期_工作日", "工厂货期_工作日")
    colsToTest = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14)

    For i = LBound(fieldsToTest) To UBound(fieldsToTest)
        fName = fieldsToTest(i)
        fVal = ws.Cells(testRow, colsToTest(i)).Value

        On Error Resume Next
        ' 尝试赋值
        rs.Fields(fName).Value = fVal

        If Err.Number <> 0 Then
            Dim fieldErr As String
            fieldErr = Err.Description
            On Error GoTo 0

            MsgBox "?? 抓到内鬼了！（在写入阶段报错）" & vbCrLf & vbCrLf & _
                   "是在给字段【" & fName & "】写入数据时触发的类型不匹配！" & vbCrLf & _
                   "?? 准备写入的 Excel 值为：[" & CStr(fVal) & "]" & vbCrLf & _
                   "?? 该值在 VBA 中的数据类型识别为：" & TypeName(fVal) & vbCrLf & vbCrLf & _
                   "?? 原因分析：很可能是 Excel 里是个空单元格，或者是段文本，但 Access 里这个字段要求必须是数字/日期。" & vbCrLf & vbCrLf & _
                   "系统原始报错：" & fieldErr, vbCritical

            rs.CancelUpdate
            rs.Close
            conn.Close
            Exit Sub
        End If
        On Error GoTo 0
    Next i

    ' 如果跑到了这里，说明完全没报错
    rs.CancelUpdate ' 仅仅是测试，取消更新，防止产生脏数据
    rs.Close
    conn.Close

    MsgBox "?? 排查完成！" & vbCrLf & vbCrLf & _
           "奇怪的是，脚本测试了第一条数据，并没有发生报错。" & vbCrLf & _
           "如果是这样，那可能意味着并不是每次都会报错，而是 Excel 里某一行特定的数据（比如某个数字没填留空了）导致了错误。我们需要重点检查那些空白单元格。", vbInformation
End Sub