before update - validating potential new data

[gbb0330]

Hi all

i would like to thank Darryl, he helped me a lot

now i have another problem

LeBayNum is the primary key in [tblListedItems]
relates to SeBayNum in tblSold
relationship is one LeBayNUM to many SeBayNUM

duplicate numbers are not allowed, so
i am trying to bypass access error handling with the following
procedure in the before update event of the textbox LeBayNUM

Private Sub LeBayNUM_BeforeUpdate(Cancel As Integer)
On Error GoTo ErrorHandler
Dim Cnn As New ADODB.Connection
Dim Rst As New ADODB.Recordset
Set Rst = New ADODB.Recordset
Dim Response As Integer
If IsNull(Forms![frmlisted_3]![frmllisteditems
subform].Form![LeBayNUM]) Or Forms![frmlisted_3]![frmllisteditems
subform].Form![LeBayNUM] = " " Then
Response = MsgBox("eBay Number Must be Entered!" & vbCrLf & "Do You
Want to Cancel the Entry?", vbYesNo)
If Response = vbNo Then
Cancel = True
GoTo done
Else
Forms![frmlisted_3]![frmllisteditems
subform].Form![LeBayNUM].Undo
Cancel = True
GoTo done
End If
Else
If (Forms![frmlisted_3]![frmllisteditems subform].Form![LeBayNUM]
<> Forms![frmlisted_3]![frmllisteditems
subform].Form![LeBayNUM].OldValue) Or
IsNull(Forms![frmlisted_3]![frmllisteditems
subform].Form![LeBayNUM].OldValue) Then

Cnn.Open CurrentProject.Connection
Rst.Open "Select [LeBayNUM] from TblListedItems", Cnn,
adOpenForwardOnly, adLockOptimistic

If Not Rst.EOF Then
Response = MsgBox("Duplicate eBay Number!" & vbCrLf & "Do You Want
to Cancel The Entry?", vbYesNo)
If Response = vbYes Then
Forms![frmlisted_3]![frmllisteditems subform].Form![LeBayNUM].Undo
End If
End If
Rst.Close
Set Rst = Nothing
End If
End If

GoTo done

ErrorHandler:
MsgBox Err.Description
done:
End Sub

i cant get i to work
this is the error message:
the database has been placed in a state by user 'admin' on machine
'ibm-a2423412' that prevents it from being opened or locked

[Darryl Kerkeslager]

"gbb0330" <gb*****@gmail.com> wrote

LeBayNum is the primary key in [tblListedItems]
relates to SeBayNum in tblSold
relationship is one LeBayNUM to many SeBayNUM

duplicate numbers are not allowed, so
i am trying to bypass access error handling with the following
procedure in the before update event of the textbox LeBayNUM

the database has been placed in a state by user 'admin' on machine
'ibm-a2423412' that prevents it from being opened or locked

*I think* the problem is that you are attempting to undo the new value, and
use Cancel=True. My own BeforeUpdate events are pretty simple affairs, that
check the value, and if it's not valid, then Cancel=True. No undo.

Now, you've also got this code in ab event associated with LeBayNUM, which
looks like a textbox in a subform. But your code appears to be referencing
the textbox later as Forms![frmlisted_3]![frmllisteditems
subform].Form![LeBayNUM] rather than just Me.LeBayNUM. I really have no
idea what effect that wiould have, but if that is what you are doing, by all
means simplify it.

Try this:

Private Sub LeBayNUM_BeforeUpdate(Cancel As Integer)
On Error GoTo ErrorHandler
Dim Cnn As ADODB.Connection ' Don't use New here
Dim Rst As ADODB.Recordset ' Don't use New here
SetSet Cnn = CurrentProject.Connection ' changed Cnn open
Set Rst = New ADODB.Recordset
Dim Response As Integer

If IsNull(Me.LeBayNUM) Or Me.LeBayNUM = " " Then
Response = MsgBox("eBay Number Must be Entered!" & _
vbCrLf & "Do You Want to Cancel the Entry?", vbYesNo)
If Response = vbYes Then
Cancel = True
End If
Else
If (Me.LeBayNUM] <>Me.LeBayNUM.OldValue) Or _
IsNull(Me.LeBayNUM.OldValue) Then
' Specify Source separately - easier to read
Rst.Source = "Select [LeBayNUM] from TblListedItems"
' Add adCmdText parameter for SQL strings - faster
' Use adCmdTable for tables
' Only need ReadOnly for this - no updates - faster
Rst.Open , Cnn, adOpenForwardOnly, adReadOnly, adCmdText
If Not Rst.EOF Then
Response = MsgBox("Duplicate eBay Number!" & vbCrLf & _
"Do You Want to Cancel The Entry?", vbYesNo)
If Response = vbYes Then
Cancel = True
End If
End If
Rst.Close
End If
End If
Set Rst = Nothing ' needs to be here to always execute
GoTo done
ErrorHandler:
MsgBox Err.Description
done:
End Sub

Darryl Kerkeslager