Could not update; currently locked by another session on this machine.

[Mark Reed]

Hi All,
I'm having a problem with the following code. I've read quite a lot of
old posts regarding the issue but none seem to affer a solution.

The scenario is. I have a bound form which contains a couple of memo fields.
I need to keep some sort of log as to when each update of the memo field
occurs so I have locked bot the memo fields on the main form. To edit them,
the user double clicks the ememo field which then opens an unbound form.
They eneter their update and then click a command button which runs the
below code. All works fine until the memo field grws too large.

From what I gather, the size of the memo field is the deciding factor. As
soon as the update takes the character count past 2000, the below code
produces the "Could not update; currently locked by another session on this
machine." error.

Can anyone offer any solutions as I'm really stuck on this one.

TIA,

Mark

Public Sub cmd_UpdateMemo_Click()
On Error GoTo UpdateError
Dim SubName As String
SubName = "Private Sub cmd_UpdateMemo_Click()"
If MsgBox("Are you sure?", vbYesNo + vbQuestion, "Confirm Update") = vbNo
Then
DoCmd.Close acForm, "frm_Memo_Update"
Exit Sub
End If

Dim strUser As String

'Use DisplayName function to get Current users Full Name
strUser = Displayname(Forms!frm_UserLogin!txt_UserID)

Dim db As DAO.Database, RS As DAO.Recordset, StrSQL As String, strCriteria
As String, strFieldName As String
Set db = CurrentDb
StrSQL = "Select * from tbl_IRs;"
strFieldName = Me.OpenArgs
strCriteria = "[IR_Number] = '" & Forms!frm_IR_Entry!IR_Number & "'" '**This
is the Record 's unique ID **

Set RS = db.OpenRecordset(StrSQL)
With RS
.FindFirst strCriteria
.Edit
If IsNull(RS(strFieldName)) Then
RS(strFieldName) = "(" & strUser & " - " & Format(Now, "hh:nn ddd
dd-mmm-yy") & ")" & vbCrLf & Me.txt_Addition
DoCmd.Close acForm, "frm_Memo_Update"
Else
RS(strFieldName) = RS(strFieldName) & vbCrLf & vbCrLf & "(" &
strUser & " - " & Format(Now, "hh:nn ddd dd-mmm-yy") & ")" & vbCrLf &
Me.txt_Addition
DoCmd.Close acForm, "frm_Memo_Update"
End If
.Update
End With
RS.Close
Set RS = Nothing

UpdateExit:
Exit Sub

UpdateError:
LogLine (SubName & " - " & Err.Description)
Resume UpdateExit

End Sub

[Mark Reed]

All,
after days of research, the only solution I could find was to close the
main form.

Below is how I did it!!!!

Public Sub cmd_UpdateMemo_Click()
On Error GoTo UpdateError

Dim SubName As String
Dim ControlName As String
Dim IR_No As String
Dim strUser As String
ControlName = Mid(Me.OpenArgs, 1, InStr(Me.OpenArgs, ";") - 1)
IR_No = Mid(Me.OpenArgs, InStr(Me.OpenArgs, ";") + 1)
SubName = "Private Sub cmd_UpdateMemo_Click()"
strUser = Displayname(Forms!frm_UserLogin!txt_UserID) 'Use DisplayName
function to get Current users Full Name

'If no update is required, close the form and drop changes
If MsgBox("Are you sure?", vbYesNo + vbQuestion, "Confirm Update") = vbNo
Then
DoCmd.Close acForm, "frm_Memo_Update"
Exit Sub
End If

'An update is required
'Release the unbound locks on the form

Forms!frm_IR_Entry!txt_LockedIR = Null
Forms!frm_IR_Entry!chk_HasLock = False

'Then close the form
DoCmd.Close acForm, "frm_IR_Entry", acSaveYes
'Set the recordset ready for update
Dim db As DAO.Database, RS As DAO.Recordset, StrSQL As String, strCriteria
As String, strFieldName As String
Set db = CurrentDb
StrSQL = "Select * from tbl_IRs;"
strFieldName = ControlName
strCriteria = "[IR_Number] = '" & IR_No & " '" '**This is the Record 's
unique ID **

Set RS = db.OpenRecordset(StrSQL)
With RS
.FindFirst strCriteria
.Edit
If IsNull(RS(strFieldName)) Then
RS(strFieldName) = "(" & strUser & " - " & Format(Now, "hh:nn ddd
dd-mmm-yy") & ")" & vbCrLf & Me.txt_Addition
DoCmd.Close acForm, "frm_Memo_Update"
Else
RS(strFieldName) = RS(strFieldName) & vbCrLf & vbCrLf & "(" &
strUser & " - " & Format(Now, "hh:nn ddd dd-mmm-yy") & ")" & vbCrLf &
Me.txt_Addition
DoCmd.Close acForm, "frm_Memo_Update"
End If
.Update
End With
RS.Close
Set RS = Nothing

'Update complete, re-open the form at the same record and then set the
unbound locks again
DoCmd.OpenForm "frm_IR_Entry", acNormal, , "IR_NUmber = '" & IR_No & "'"
Forms!frm_IR_Entry!txt_LockedIR = IR_No
Forms!frm_IR_Entry!chk_HasLock = True

UpdateExit:
Exit Sub

UpdateError:
LogLine (SubName & " - " & Err.Description)
'MsgBox Err.Description
Resume UpdateExit

End Sub


"Mark Reed" <ma*********@ntlworld.com> wrote in message
news:lg************@newsfe6-win.ntli.net...
Hi All,
I'm having a problem with the following code. I've read quite a lot of
old posts regarding the issue but none seem to affer a solution.

The scenario is. I have a bound form which contains a couple of memo fields.
I need to keep some sort of log as to when each update of the memo field
occurs so I have locked bot the memo fields on the main form. To edit them,
the user double clicks the ememo field which then opens an unbound form.
They eneter their update and then click a command button which runs the
below code. All works fine until the memo field grws too large.

From what I gather, the size of the memo field is the deciding factor. As
soon as the update takes the character count past 2000, the below code
produces the "Could not update; currently locked by another session on this
machine." error.

Can anyone offer any solutions as I'm really stuck on this one.

TIA,

Mark

Public Sub cmd_UpdateMemo_Click()
On Error GoTo UpdateError
Dim SubName As String
SubName = "Private Sub cmd_UpdateMemo_Click()"
If MsgBox("Are you sure?", vbYesNo + vbQuestion, "Confirm Update") = vbNo
Then
DoCmd.Close acForm, "frm_Memo_Update"
Exit Sub
End If

Dim strUser As String

'Use DisplayName function to get Current users Full Name
strUser = Displayname(Forms!frm_UserLogin!txt_UserID)

Dim db As DAO.Database, RS As DAO.Recordset, StrSQL As String, strCriteria
As String, strFieldName As String
Set db = CurrentDb
StrSQL = "Select * from tbl_IRs;"
strFieldName = Me.OpenArgs
strCriteria = "[IR_Number] = '" & Forms!frm_IR_Entry!IR_Number & "'" '**This
is the Record 's unique ID **

Set RS = db.OpenRecordset(StrSQL)
With RS
.FindFirst strCriteria
.Edit
If IsNull(RS(strFieldName)) Then
RS(strFieldName) = "(" & strUser & " - " & Format(Now, "hh:nn ddd
dd-mmm-yy") & ")" & vbCrLf & Me.txt_Addition
DoCmd.Close acForm, "frm_Memo_Update"
Else
RS(strFieldName) = RS(strFieldName) & vbCrLf & vbCrLf & "(" &
strUser & " - " & Format(Now, "hh:nn ddd dd-mmm-yy") & ")" & vbCrLf &
Me.txt_Addition
DoCmd.Close acForm, "frm_Memo_Update"
End If
.Update
End With
RS.Close
Set RS = Nothing

UpdateExit:
Exit Sub

UpdateError:
LogLine (SubName & " - " & Err.Description)
Resume UpdateExit

End Sub