求助：用VBA实现Access表单值重复校验时出现报错

问题根源 #

你当前的代码存在两个关键错误：

1. VBA不支持直接嵌入SQL的EXISTS谓词作为条件判断，语法不兼容
2. LostFocus事件没有Cancel参数，这会直接导致运行时错误

正确实现方法 #

推荐两种简单可行的实现方案，按需选择：

方案1：使用DCount函数（简洁高效）

替换原有代码为以下内容：

Private Sub Donor_Key_LostFocus()
    Dim donorKey As Variant
    donorKey = Me.Donor_Key.Value
    
    ' 保留你原有的空值判断逻辑
    If IsNull(donorKey) Then Exit Sub
    
    ' 统计数据表中匹配当前输入的记录数
    If DCount("Donor_Key", "tblDonor", "Donor_Key = '" & donorKey & "'") > 0 Then
        MsgBox "输入的捐赠者编号已存在，请按ESC键撤销该记录。", vbExclamation
        ' 可选：将焦点放回输入框，方便修改
        Me.Donor_Key.SetFocus
    End If
End Sub

注意：如果Donor_Key是数字类型，去掉代码中的单引号，改为"Donor_Key = " & donorKey

方案2：使用Recordset查询（适合复杂场景）

如果需要获取重复记录的额外信息，可采用记录集方式：

Private Sub Donor_Key_LostFocus()
    Dim donorKey As Variant
    Dim rs As Recordset
    Dim strSQL As String
    
    donorKey = Me.Donor_Key.Value
    If IsNull(donorKey) Then Exit Sub
    
    ' 构建查询语句
    strSQL = "SELECT Donor_Key FROM tblDonor WHERE Donor_Key = '" & donorKey & "'"
    Set rs = CurrentDb.OpenRecordset(strSQL)
    
    ' 判断是否存在重复记录
    If Not rs.EOF Then
        MsgBox "输入的捐赠者编号已存在，请按ESC键撤销该记录。", vbExclamation
        Me.Donor_Key.SetFocus
    End If
    
    ' 释放资源
    rs.Close
    Set rs = Nothing
End Sub

额外优化建议 #

• 改用BeforeUpdate事件替代LostFocus，能在记录保存前拦截重复值，逻辑更严谨：

  Private Sub Donor_Key_BeforeUpdate(Cancel As Integer)
      Dim donorKey As Variant
      donorKey = Me.Donor_Key.Value
      
      If IsNull(donorKey) Then Exit Sub
      
      If DCount("Donor_Key", "tblDonor", "Donor_Key = '" & donorKey & "'") > 0 Then
          MsgBox "输入的捐赠者编号已存在，请修改后重试。", vbExclamation
          Cancel = True ' 取消更新操作
          Me.Donor_Key.SetFocus
      End If
  End Sub
  

• 给tblDonor的Donor_Key字段设置唯一索引，从数据库层面防止重复值，和VBA检查形成双重保障

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