From time to time, I randomly receive "Can't updated, Currently
locked" error 3218 or 3246 from the following code in one of my form
with pessimistic lock for 70 users environment. Any problem with the
code?
Private Sub Save_Record_Click()
Dim stSQL As String
Dim rs As Object
Set rs = CreateObject("ADODB.Recordset")
stSQL = "select * from [Openers DB] where [SRF#]= '" & Me![SRF#] &
"' AND [Opening Date Start]= #" & Me![Opening Date Start] & "# AND
[Opening Time Start]= #" & Me![Opening Time Start] & "#"
rs.Open stSQL, Application.CurrentProject.Connection
If Not (rs.EOF) Then
rs.Close
Set rs = Nothing
MsgBox "Can't save record, duplicate Opening Time" & Chr(13) &
"Please click Mail button for time correction", , "Warning"
Exit Sub
Else
rs.Close
Set rs = Nothing
DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, ,
acMenuVer70
DoCmd.DoMenuItem acFormBar, acRecordsMenu, 5, , acMenuVer70
DoCmd.SetWarnings False
DoCmd.RunSQL "INSERT INTO [Openers DB] ([Client Name], [SRF#],
[Product Code], [AM#], [Resp Transit], [Existing Amount], [Amount
Request], PSOA, [Gate Date], [Gate Time], [Opening Date Start],
[Opening Time Start], [Opening Date Finish], [Opening Time Finish],
[Opener Initial], [Opener Comment], Pushback) SELECT [Client Name],
[SRF#], [Product Code], [AM#], [Resp Transit], [Existing Amount],
[Amount Request], PSOA, [Gate Date], [Gate Time], [Opening Date
Start], [Opening Time Start], [Opening Date Finish], [Opening Time
Finish], [Opener Initial], [Opener Comment], Pushback FROM SBCD where
[SRF#] = '" & Me![SRF#] & "'"
DoCmd.SetWarnings True
DoCmd.Close acForm, "OPENING TEAM"
End If
End If
End Sub