How to avoid entering a duplicate entry in a database? - vb6

Question

I have a VB6 application where I am trying to avoid inserting a duplicate entry of a PIN number. But my code is always saving the duplicate entry.
Here is my current code:
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
And here is my calling code for this 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
How can I fix this code to avoid entering a duplicate entry?
Edit: Adding in ExecuteSQL function code
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

Answer 1

It looks like you've thrown extra logic into your function to try to fix your problem. This:
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
Stripped of all extraneous logic, can be replaced with this:
With lrsTemp1
IsPIN_NOExists = Not (.BOF And .EOF)
If IsPIN_NOExists Then
EmployeeCode = lrsTemp1.Fields("EMPLOYEE_CODE")
End If
End With
(Presumably, all your MsgBoxes are to try to troubleshoot what's wrong, so they can be left out.)
Now, the logic in your function, in plain English, is "If the PIN exists in the database, then return true." Looking at your calling code, your logic in plain English is "If the function returns true then tell the user that the PIN already exists." Since this logic is correct, it follows that your error is somewhere else in your code.
Your error is very probably somewhere in the code itself. Disable your error handler (just comment out the "on error" statement) and you will probably find that you get an error on another line. As a general rule, don't put error handlers in your code until you are sure that it works as intended. Error handlers are for users, not developers.
The way that you have your error handler set up, if you get an error your code will keep adding the duplicate error, which is the problem that you describe. So it seems likely that that is your problem. Now, without intending to be offensive, I must also tell you that this is a very bad (terrible, even) error handling design. Your logic in plain English is "if there is an error, tell the calling code that you didn't find a duplicate key." That's not so good, is it? :) For example, if you have an error in your SQL statement, then your code will insert the duplicate PIN.
Also, your function sounds like "PIN doesn't exist", when you are returning true if it does exist. Consider renaming it to something like "PIN_IsDuplicate" or better (that is, more consistent with standard naming conventions) "IsDuplicatePIN".
***** EDIT *****
Ok, I believe I have your solution. If you are too conscientious about "cleaning up" your open object references, you run the risk of dropping them before you are finished using them. In this case, you are attempting to break the active connection to your recordset, because you are under the incorrect impression that the connection is only necessary when you first pull the data from the recordset. While this is true in the .Net world, it is only true in the VB6 world if you specifically set up a "disconnected recordset."
Your problem is with this line of code:
Set lrs.ActiveConnection = Nothing
When you do this, you will get the error (if you disable your error handler) "Operation is not allowed when object is open." This means that you have to maintain your connection to the database as long as the recordset is open, which it is until you close it or until the function ends.
Tracing through your code, if you get an error on this line by trying to destroy the connection, then you call your error handler. The error handler tells the function to return a null object pointer to the calling function. So, in the calling function, this line of code:
Set lrsTemp1 = cObjDBConn.ExecuteSQL(lstrSQL1)
actually sets lrsTemp1 to Nothing. Therefore, the first condition of your If block is satisfied, and your function returns False as instructed. This gives the obscure behavior that you understandably found confusing.
So, here's what to take away from this. First, error handlers are for users, not for developers. They should be the last step in your coding process, because they turn runtime errors into logical errors which are harder to find. If you find that you have errors in code that has error handlers in place, the first step is to disable all error handlers. To do this, go to Tools/Options/General and select Break on All Errors. That will cause the runtime to ignore the error handlers.
Next, don't keep setting things to Nothing. A lot of misguided expertise in earlier versions of VB suggests that you need to do this. In truth, the VB runtime is much better at releasing object references that go out of scope than you are. It does so automatically in all but a few very well defined situations which you are unlikely to encounter. So, get rid of all of your "Set Object = Nothing" statements. You don't need them, and as you are finding out, they can cause errors.
One thing that it is helpful to do, however, is to explicitly close your connection (call the connection object's Close method) when you are done using it. Dropping the Recordset's ActiveConnection property doesn't close the connection, it just says that the recordset doesn't want to use it anymore. Also, if you quit using it by setting the connection variable to nothing, the server won't automatically be notified that the connection is closed. It will get around to figuring it out eventually, but you will save resources by doing it in your code.
Finally, get clearer on the different types of cursors. The default CursorType is adOpenForwardOnly, a cursor which only supports MoveFirst and MoveNext. This is the simplest one, which is appropriate for either selecting a single value (as you are) or iterating through a recordset from top to bottom (for example, when populating a listbox with the contents of the recordset). This cursor must remain connected to the database until you close the recordset, which is why you get an error when you try to drop the active connection.
If you want a recordset that you can still use after disconnecting from the database, you need a client-side recordset, and will need to set the CursorLocation property to adUseClient. This can only have a CursorType of adOpenStatic, which is a fully-traversable (supports moving backwards, forwards, by multiple records, etc.) non-updateable cursor--a "static" or "snapshot" cursor. (If you set the CursorLocation property to adUseClient, the CursorType will be automatically forced to adOpenStatic.)
If you want to do all this, you can't use the Execute method of the Connection object. Instead, you have to use the Recordset's Open method. Here's a bit of code that pulls the authors table from the SQL Server pubs sample database into a disconnected recordset and prints all the last names to the debug 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