如何在Excel导出到Access的VBA代码中添加验证逻辑

当然可以实现这个验证逻辑，下面是修改后的完整VBA代码，已经加入了id_cot重复检查和用户确认功能：

Const TARGET_DB = "ProductsDB.accdb"

Sub PushTableToAccess()
    Dim cnn As New ADODB.Connection
    Dim MyConn As String
    Dim rst As ADODB.Recordset
    Dim existingIDs As Collection
    Dim i As Long, j As Long
    Dim Rw As Long
    Dim duplicateIDs As String
    Dim userResponse As VbMsgBoxResult
    Dim currentID As Variant
    
    ' 初始化存储已存在ID的集合
    Set existingIDs = New Collection
    
    Sheets("bd").Activate
    Rw = Range("A65536").End(xlUp).Row
    
    ' 连接Access数据库
    MyConn = ThisWorkbook.Path & Application.PathSeparator & TARGET_DB
    With cnn
        .Provider = "Microsoft.ACE.OLEDB.12.0"
        .Open MyConn
    End With
    
    ' 第一步：获取Access表中已有的id_cot值
    Set rst = New ADODB.Recordset
    rst.Open Source:="SELECT id_cot FROM CLNTITPUB", ActiveConnection:=cnn, _
             CursorType:=adOpenStatic, LockType:=adLockReadOnly
    
    ' 将已存在的ID存入集合（用字符串做键值确保查重准确）
    Do While Not rst.EOF
        On Error Resume Next ' 忽略Access表本身可能存在的重复ID
        existingIDs.Add rst("id_cot"), Key:=CStr(rst("id_cot"))
        On Error GoTo 0
        rst.MoveNext
    Loop
    rst.Close
    
    ' 第二步：检查待导出数据中的id_cot是否重复（假设id_cot在Excel第1列，需修改请调整列索引）
    duplicateIDs = ""
    For i = 2 To Rw
        currentID = Cells(i, 1).Value
        On Error Resume Next
        ' 尝试获取集合中的对应ID，无报错则说明重复
        existingIDs.Item(CStr(currentID))
        If Err.Number = 0 Then
            duplicateIDs = IIf(duplicateIDs = "", CStr(currentID), duplicateIDs & ", " & CStr(currentID))
        End If
        On Error GoTo 0
    Next i
    
    ' 第三步：根据检查结果处理
    If duplicateIDs <> "" Then
        userResponse = MsgBox("发现重复的id_cot值：" & duplicateIDs & vbCrLf & "是否继续导出？", vbYesNo + vbExclamation, "重复ID提示")
        If userResponse = vbNo Then
            ' 用户选择终止，清理资源后退出
            cnn.Close
            Set rst = Nothing
            Set cnn = Nothing
            Set existingIDs = Nothing
            Exit Sub
        End If
    End If
    
    ' 第四步：执行原导出逻辑
    Set rst = New ADODB.Recordset
    rst.CursorLocation = adUseServer
    rst.Open Source:="CLNTITPUB", ActiveConnection:=cnn, _
             CursorType:=adOpenDynamic, LockType:=adLockOptimistic, _
             Options:=adCmdTable
    
    For i = 2 To Rw
        rst.AddNew
        For j = 1 To 19
            rst(Cells(1, j).Value) = Cells(i, j).Value
        Next j
        rst.Update
    Next i
    
    ' 清理资源
    rst.Close
    cnn.Close
    Set rst = Nothing
    Set cnn = Nothing
    Set existingIDs = Nothing
    
    MsgBox "数据导出完成！", vbInformation
End Sub

关键逻辑说明 #

• 已有ID收集：通过查询Access表的id_cot字段，把所有已存在的ID存入集合，利用集合的键值特性实现快速查重
• 重复检查：遍历Excel待导出数据的ID列，对比集合中的已存ID，收集所有重复值
• 用户确认流程：如果发现重复ID，弹出提示框展示重复内容，用户选择No则终止导出，选择Yes则继续执行原导出操作
• 注意：如果Excel中id_cot不在第1列，请修改Cells(i, 1).Value中的列索引

内容的提问来源于stack exchange，提问作者pedrosjo