如何避免在数据库中输入重复条目？
How to avoid entering a duplicate entry in a database?
我有一个 VB6 应用程序，我试图在其中避免插入重复的 PIN 码条目。但是我的代码总是保存重复的条目。
这是我当前的代码：
Public Function IsPIN_NOExists(ByVal TableName As String, _
ByRef EmployeeCode As String, ByVal FieldName As String, ByVal DataToCheck As String, _
Optional ByVal CodeFieldName As String, Optional ByVal CodeFieldValue As String) As Boolean
TableName = UCase$(Trim$(TableName))
EmployeeCode = Trim$(EmployeeCode)
On Error GoTo ErrorHandle
Dim lstrSQL1 As String
Dim lrsTemp1 As ADODB.Recordset
lstrSQL1 = " Select " & FieldName & " from " & TableName & " Where PIN_NO =" & DataToCheck & ""
If Len(Trim$(CodeFieldName)) <> 0 And Len(Trim$(CodeFieldValue)) <> 0 Then
lstrSQL1 = lstrSQL1 & " AND " & CodeFieldName & " <> '" & CodeFieldValue & "'"
End If
Set lrsTemp1 = cObjDBConn.ExecuteSQL(lstrSQL1)
If lrsTemp1 Is Nothing Then
IsPIN_NOExists = False
ElseIf Not (lrsTemp1.BOF And lrsTemp1.EOF) Then
IsPIN_NOExists = True
lrsTemp1.MoveFirst
EmployeeCode = lrsTemp1.Fields("EMPLOYEE_CODE")
MsgBox (EmployeeCode)
ElseIf lrsTemp1.RecordCount = 0 Then
IsPIN_NOExists = False
Else
IsPIN_NOExists = False
End If
If lrsTemp1.State = adStateOpen Then lrsTemp1.Close
Set lrsTemp1 = Nothing
Exit Function
ErrorHandle:
IsPIN_NOExists = False
End Function
这里是我调用这个函数的代码：
If Trim$(TxtPINno.text) <> "" And Trim$(TxtPINno.text) <> "-" Then
'If gObjValidation.IsCodeExists(fstrTableName, gEmployerCode, "PIN_NO", Trim$(TxtPINno.text)) = True Then
If gobjValidation.IsDescriptionExists(fstrTableName, gEmployerCode, "PIN_NO", Trim$(TxtPINno.text), "EMPLOYEE_ID", Val(txtEmpCode.Tag)) = True Then
If gobjValidation.IsPIN_NOExists(fstrTableName, gEmployeeCode, "EMPLOYEE_CODE", _
Trim$(TxtPINno.text)) = True Then
MsgBox (gEmployeeCode)
Call MessageBox("This PIN Number is already existing for another employee. Cannot enter duplicate number!", OKOnly, Information, DefaultButton1, Me.Caption)
sstInformationTab.Tab = 0
If TxtPINno.Enabled = True Then TxtPINno.SetFocus
CheckAllValidations = False
Exit Function
End If
End If
End If
如何修改此代码以避免输入重复条目？
编辑：添加 ExecuteSQL 函数代码
Public Function ExecuteSQL(ByVal SQLQueryStatement As String) As ADODB.Recordset
On Error GoTo ErrorHandler
Dim lrs As ADODB.Recordset
cintDBHitCtr = cintDBHitCtr + 1
Set lrs = DBConnection.Execute(SQLQueryStatement, , adCmdText)
Set lrs.ActiveConnection = Nothing
Set ExecuteSQL = lrs
Set lrs = Nothing
Exit Function
ErrorHandler:
Set ExecuteSQL = Nothing
Call TrapDatabaseError(SQLQueryStatement, DBConnection.Errors(0), cDBType)
End Function
您似乎在函数中加入了额外的逻辑来尝试解决您的问题。这个：
If lrsTemp1 Is Nothing Then
IsPIN_NOExists = False
ElseIf Not (lrsTemp1.BOF And lrsTemp1.EOF) Then
IsPIN_NOExists = True
lrsTemp1.MoveFirst
EmployeeCode = lrsTemp1.Fields("EMPLOYEE_CODE")
MsgBox (EmployeeCode)
ElseIf lrsTemp1.RecordCount = 0 Then
IsPIN_NOExists = False
Else
IsPIN_NOExists = False
End If
去掉所有无关的逻辑，可以替换为：
With lrsTemp1
IsPIN_NOExists = Not (.BOF And .EOF)
If IsPIN_NOExists Then
EmployeeCode = lrsTemp1.Fields("EMPLOYEE_CODE")
End If
End With
（大概，您所有的 MsgBox 都是为了尝试解决问题，所以可以忽略它们。）
现在，您函数中的逻辑，用简单的英语来说，是 "If the PIN exists in the database, then return true." 查看您的调用代码，用简单的英语，您的逻辑是 "If the function returns true then tell the user that the PIN already exists." 由于这个逻辑是正确的，因此您的错误在您的代码中的其他地方。
您的错误很可能出在代码本身的某处。禁用错误处理程序（只需注释掉 "on error" 语句），您可能会发现在另一行出现错误。作为一般规则，在您确定代码按预期工作之前，不要将错误处理程序放入您的代码中。错误处理程序是为用户而不是开发人员准备的。
您设置错误处理程序的方式，如果您遇到错误，您的代码将继续添加重复错误，这就是您描述的问题。所以这似乎是你的问题。现在，无意冒犯，我还必须告诉您，这是一个非常糟糕（可怕，甚至）的错误处理设计。用简单的英语来说，你的逻辑是 "if there is an error, tell the calling code that you didn't find a duplicate key." 那不太好，是吗？ :) 例如，如果您的 SQL 语句有误，您的代码将插入重复的 PIN。
此外，如果 存在，当您 return 为真时，您的函数听起来像 "PIN doesn't exist"。考虑将其重命名为 "PIN_IsDuplicate" 或更好的名称（即更符合标准命名约定）"IsDuplicatePIN"。
***** 编辑 *****
好的，我相信我有你的解决方案。如果您对 "cleaning up" 您的开放对象引用过于谨慎，您可能会 运行 在使用完它们之前丢弃它们的风险。在这种情况下，您试图断开与记录集的活动连接，因为您错误地认为只有在第一次从记录集中提取数据时才需要连接。虽然这在 .Net 世界中是正确的，但只有在 VB6 世界中如果您专门设置 "disconnected recordset."
你的问题出在这行代码上：
Set lrs.ActiveConnection = Nothing
执行此操作时，您将收到错误（如果禁用错误处理程序）"Operation is not allowed when object is open."这意味着只要记录集处于打开状态，您就必须保持与数据库的连接，这直到您关闭它或直到函数结束。
跟踪您的代码，如果您通过尝试破坏连接而在此行遇到错误，那么您将调用您的错误处理程序。错误处理程序告诉函数 return 一个指向调用函数的空对象指针。所以，在调用函数中，这行代码：
Set lrsTemp1 = cObjDBConn.ExecuteSQL(lstrSQL1)
实际上将 lrsTemp1 设置为 Nothing。因此，您的 If 块的第一个条件得到满足，并且您的函数 returns False 按照指示。这给出了你可以理解的令人困惑的模糊行为。
所以，这是从中得到的东西。首先，错误处理程序是为用户服务的，而不是为开发人员服务的。它们应该是编码过程的最后一步，因为它们将 运行 时间错误转化为更难发现的逻辑错误。如果您发现在具有错误处理程序的代码中有错误，第一步是禁用所有错误处理程序。为此，请转到 Tools/Options/General 和 select 遇到所有错误时中断。这将导致 运行时间忽略错误处理程序。
接下来，不要一直设置为 Nothing。 VB 早期版本中的许多误导性专业知识表明您需要这样做。事实上，VB 运行时间在释放超出范围的对象引用方面比你要好得多。除了少数您不太可能遇到的定义明确的情况外，它会自动执行此操作。因此，删除所有 "Set Object = Nothing" 语句。您不需要它们，而且您会发现它们可能会导致错误。
然而，有一点很有帮助，那就是在使用完连接后显式关闭连接（调用连接对象的 Close 方法）。删除 Recordset 的 ActiveConnection 属性 不会关闭连接，它只是表示记录集不想再使用它了。此外，如果您通过将连接变量设置为空来停止使用它，则服务器不会自动收到连接已关闭的通知。它最终会解决它，但您可以通过在代码中这样做来节省资源。
最后，更清楚地了解不同类型的游标。默认的 CursorType 是 adOpenForwardOnly，一个只支持 MoveFirst 和 MoveNext 的游标。这是最简单的一个，适用于 selecting 单个值（如您所愿）或从上到下遍历记录集（例如，当用记录集的内容填充列表框时）。在您关闭记录集之前，此游标必须保持与数据库的连接，这就是当您尝试断开活动连接时会收到错误消息的原因。
如果您想要一个在与数据库断开连接后仍然可以使用的记录集，您需要一个客户端记录集，并且需要将 CursorLocation 属性 设置为 adUseClient。这只能有一个 adOpenStatic 的 CursorType，它是一个完全可遍历（支持向后移动、向前移动、按多条记录移动等）的不可更新游标——"static" 或 "snapshot" 游标。 （如果将 CursorLocation 属性 设置为 adUseClient，则 CursorType 将自动强制为 adOpenStatic。）
如果你想做这一切，你不能使用Connection对象的Execute方法。相反，您必须使用 Recordset 的 Open 方法。下面是一些代码，可以将作者 table 从 SQL 服务器 pubs 示例数据库中提取到断开连接的记录集中，并将所有姓氏打印到调试 window:
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Set cn = New ADODB.Connection
cn.Open "Provider=SQLOLEDB.1;Persist Security Info=False;Data Source=.\SQLEXPRESS;Initial Catalog=pubs;Integrated Security=SSPI;"
Set rs = New ADODB.Recordset
With rs
.CursorLocation = adUseClient
.Open "select * from authors", cn, adOpenStatic
Set .ActiveConnection = Nothing
cn.Close
Do Until .EOF
Debug.Print .Fields("au_lname")
.MoveNext
Loop
.MoveFirst
End With
我有一个 VB6 应用程序，我试图在其中避免插入重复的 PIN 码条目。但是我的代码总是保存重复的条目。
这是我当前的代码：
Public Function IsPIN_NOExists(ByVal TableName As String, _
ByRef EmployeeCode As String, ByVal FieldName As String, ByVal DataToCheck As String, _
Optional ByVal CodeFieldName As String, Optional ByVal CodeFieldValue As String) As Boolean
TableName = UCase$(Trim$(TableName))
EmployeeCode = Trim$(EmployeeCode)
On Error GoTo ErrorHandle
Dim lstrSQL1 As String
Dim lrsTemp1 As ADODB.Recordset
lstrSQL1 = " Select " & FieldName & " from " & TableName & " Where PIN_NO =" & DataToCheck & ""
If Len(Trim$(CodeFieldName)) <> 0 And Len(Trim$(CodeFieldValue)) <> 0 Then
lstrSQL1 = lstrSQL1 & " AND " & CodeFieldName & " <> '" & CodeFieldValue & "'"
End If
Set lrsTemp1 = cObjDBConn.ExecuteSQL(lstrSQL1)
If lrsTemp1 Is Nothing Then
IsPIN_NOExists = False
ElseIf Not (lrsTemp1.BOF And lrsTemp1.EOF) Then
IsPIN_NOExists = True
lrsTemp1.MoveFirst
EmployeeCode = lrsTemp1.Fields("EMPLOYEE_CODE")
MsgBox (EmployeeCode)
ElseIf lrsTemp1.RecordCount = 0 Then
IsPIN_NOExists = False
Else
IsPIN_NOExists = False
End If
If lrsTemp1.State = adStateOpen Then lrsTemp1.Close
Set lrsTemp1 = Nothing
Exit Function
ErrorHandle:
IsPIN_NOExists = False
End Function
这里是我调用这个函数的代码：
If Trim$(TxtPINno.text) <> "" And Trim$(TxtPINno.text) <> "-" Then
'If gObjValidation.IsCodeExists(fstrTableName, gEmployerCode, "PIN_NO", Trim$(TxtPINno.text)) = True Then
If gobjValidation.IsDescriptionExists(fstrTableName, gEmployerCode, "PIN_NO", Trim$(TxtPINno.text), "EMPLOYEE_ID", Val(txtEmpCode.Tag)) = True Then
If gobjValidation.IsPIN_NOExists(fstrTableName, gEmployeeCode, "EMPLOYEE_CODE", _
Trim$(TxtPINno.text)) = True Then
MsgBox (gEmployeeCode)
Call MessageBox("This PIN Number is already existing for another employee. Cannot enter duplicate number!", OKOnly, Information, DefaultButton1, Me.Caption)
sstInformationTab.Tab = 0
If TxtPINno.Enabled = True Then TxtPINno.SetFocus
CheckAllValidations = False
Exit Function
End If
End If
End If
如何修改此代码以避免输入重复条目？
编辑：添加 ExecuteSQL 函数代码
Public Function ExecuteSQL(ByVal SQLQueryStatement As String) As ADODB.Recordset
On Error GoTo ErrorHandler
Dim lrs As ADODB.Recordset
cintDBHitCtr = cintDBHitCtr + 1
Set lrs = DBConnection.Execute(SQLQueryStatement, , adCmdText)
Set lrs.ActiveConnection = Nothing
Set ExecuteSQL = lrs
Set lrs = Nothing
Exit Function
ErrorHandler:
Set ExecuteSQL = Nothing
Call TrapDatabaseError(SQLQueryStatement, DBConnection.Errors(0), cDBType)
End Function
您似乎在函数中加入了额外的逻辑来尝试解决您的问题。这个：
If lrsTemp1 Is Nothing Then
IsPIN_NOExists = False
ElseIf Not (lrsTemp1.BOF And lrsTemp1.EOF) Then
IsPIN_NOExists = True
lrsTemp1.MoveFirst
EmployeeCode = lrsTemp1.Fields("EMPLOYEE_CODE")
MsgBox (EmployeeCode)
ElseIf lrsTemp1.RecordCount = 0 Then
IsPIN_NOExists = False
Else
IsPIN_NOExists = False
End If
去掉所有无关的逻辑，可以替换为：
With lrsTemp1
IsPIN_NOExists = Not (.BOF And .EOF)
If IsPIN_NOExists Then
EmployeeCode = lrsTemp1.Fields("EMPLOYEE_CODE")
End If
End With
（大概，您所有的 MsgBox 都是为了尝试解决问题，所以可以忽略它们。）
现在，您函数中的逻辑，用简单的英语来说，是 "If the PIN exists in the database, then return true." 查看您的调用代码，用简单的英语，您的逻辑是 "If the function returns true then tell the user that the PIN already exists." 由于这个逻辑是正确的，因此您的错误在您的代码中的其他地方。
您的错误很可能出在代码本身的某处。禁用错误处理程序（只需注释掉 "on error" 语句），您可能会发现在另一行出现错误。作为一般规则，在您确定代码按预期工作之前，不要将错误处理程序放入您的代码中。错误处理程序是为用户而不是开发人员准备的。
您设置错误处理程序的方式，如果您遇到错误，您的代码将继续添加重复错误，这就是您描述的问题。所以这似乎是你的问题。现在，无意冒犯，我还必须告诉您，这是一个非常糟糕（可怕，甚至）的错误处理设计。用简单的英语来说，你的逻辑是 "if there is an error, tell the calling code that you didn't find a duplicate key." 那不太好，是吗？ :) 例如，如果您的 SQL 语句有误，您的代码将插入重复的 PIN。
此外，如果 存在，当您 return 为真时，您的函数听起来像 "PIN doesn't exist"。考虑将其重命名为 "PIN_IsDuplicate" 或更好的名称（即更符合标准命名约定）"IsDuplicatePIN"。
***** 编辑 *****
好的，我相信我有你的解决方案。如果您对 "cleaning up" 您的开放对象引用过于谨慎，您可能会 运行 在使用完它们之前丢弃它们的风险。在这种情况下，您试图断开与记录集的活动连接，因为您错误地认为只有在第一次从记录集中提取数据时才需要连接。虽然这在 .Net 世界中是正确的，但只有在 VB6 世界中如果您专门设置 "disconnected recordset."
你的问题出在这行代码上：
Set lrs.ActiveConnection = Nothing
执行此操作时，您将收到错误（如果禁用错误处理程序）"Operation is not allowed when object is open."这意味着只要记录集处于打开状态，您就必须保持与数据库的连接，这直到您关闭它或直到函数结束。
跟踪您的代码，如果您通过尝试破坏连接而在此行遇到错误，那么您将调用您的错误处理程序。错误处理程序告诉函数 return 一个指向调用函数的空对象指针。所以，在调用函数中，这行代码：
Set lrsTemp1 = cObjDBConn.ExecuteSQL(lstrSQL1)
实际上将 lrsTemp1 设置为 Nothing。因此，您的 If 块的第一个条件得到满足，并且您的函数 returns False 按照指示。这给出了你可以理解的令人困惑的模糊行为。
所以，这是从中得到的东西。首先，错误处理程序是为用户服务的，而不是为开发人员服务的。它们应该是编码过程的最后一步，因为它们将 运行 时间错误转化为更难发现的逻辑错误。如果您发现在具有错误处理程序的代码中有错误，第一步是禁用所有错误处理程序。为此，请转到 Tools/Options/General 和 select 遇到所有错误时中断。这将导致 运行时间忽略错误处理程序。
接下来，不要一直设置为 Nothing。 VB 早期版本中的许多误导性专业知识表明您需要这样做。事实上，VB 运行时间在释放超出范围的对象引用方面比你要好得多。除了少数您不太可能遇到的定义明确的情况外，它会自动执行此操作。因此，删除所有 "Set Object = Nothing" 语句。您不需要它们，而且您会发现它们可能会导致错误。
然而，有一点很有帮助，那就是在使用完连接后显式关闭连接（调用连接对象的 Close 方法）。删除 Recordset 的 ActiveConnection 属性 不会关闭连接，它只是表示记录集不想再使用它了。此外，如果您通过将连接变量设置为空来停止使用它，则服务器不会自动收到连接已关闭的通知。它最终会解决它，但您可以通过在代码中这样做来节省资源。
最后，更清楚地了解不同类型的游标。默认的 CursorType 是 adOpenForwardOnly，一个只支持 MoveFirst 和 MoveNext 的游标。这是最简单的一个，适用于 selecting 单个值（如您所愿）或从上到下遍历记录集（例如，当用记录集的内容填充列表框时）。在您关闭记录集之前，此游标必须保持与数据库的连接，这就是当您尝试断开活动连接时会收到错误消息的原因。
如果您想要一个在与数据库断开连接后仍然可以使用的记录集，您需要一个客户端记录集，并且需要将 CursorLocation 属性 设置为 adUseClient。这只能有一个 adOpenStatic 的 CursorType，它是一个完全可遍历（支持向后移动、向前移动、按多条记录移动等）的不可更新游标——"static" 或 "snapshot" 游标。 （如果将 CursorLocation 属性 设置为 adUseClient，则 CursorType 将自动强制为 adOpenStatic。）
如果你想做这一切，你不能使用Connection对象的Execute方法。相反，您必须使用 Recordset 的 Open 方法。下面是一些代码，可以将作者 table 从 SQL 服务器 pubs 示例数据库中提取到断开连接的记录集中，并将所有姓氏打印到调试 window:
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Set cn = New ADODB.Connection
cn.Open "Provider=SQLOLEDB.1;Persist Security Info=False;Data Source=.\SQLEXPRESS;Initial Catalog=pubs;Integrated Security=SSPI;"
Set rs = New ADODB.Recordset
With rs
.CursorLocation = adUseClient
.Open "select * from authors", cn, adOpenStatic
Set .ActiveConnection = Nothing
cn.Close
Do Until .EOF
Debug.Print .Fields("au_lname")
.MoveNext
Loop
.MoveFirst
End With