提示错误如下图：



源码如下：

Option Explicit
Private Sub Adodc1_MoveComplete(ByVal adReason As ADODB.EventReasonEnum, _
ByVal pError As ADODB.Error, adStatus As ADODB.EventStatusEnum, _
ByVal pRecordset As ADODB.Recordset)
    Adodc1.Caption = "当前位置:" & Adodc1.Recordset.AbsolutePosition _
    & Space(3) & "记录总数:" & Adodc1.Recordset.RecordCount
End Sub

Private Sub cmdAdd_Click()
    '追加新记录
    Adodc1.Recordset.AddNew
    Adodc1.Recordset("类别代码") = ""
    Adodc1.Recordset("命名描述") = ""
    Adodc1.Recordset("说明") = ""
    txtSort.SetFocus
End Sub

Private Sub cmdDel_Click()
    '删除记录
    If Not (Adodc1.Recordset.EOF Or Adodc1.Recordset.BOF) Then
        Adodc1.Recordset.Delete
        Adodc1.Recordset.MoveNext
    End If
End Sub

Private Sub cmdUpdata_Click()
    Adodc1.Recordset.Update
    Unload Me
End Sub

Private Sub dblSort_Click()
    Dim strSortID As String
    strSortID = dblSort.Text
    Adodc1.Recordset.MoveFirst
    Adodc1.Recordset.Find "类别代码='" & strSortID & "'"
End Sub

Private Sub txtSort_LostFocus()
    '检验数据
    On Error Resume Next
    If Trim(txtSort) = "" Then
        MsgBox "类别代码不能为空字串!", vbExclamation
        txtSort.SetFocus
        Exit Sub
    End If
    Adodc1.Recordset.Update
   
    Select Case Err
        Case 0
        Case -2147467259
            MsgBox Error
            MsgBox "类别代码发生重复冲突!", vbExclamation
            txtSort.SetFocus
        Case Else
            txtSort.SetFocus
    End Select
End Sub

沒這樣玩過

我下载了你的附件，可以正常运行的，没有出现你说的那种情况。