I have a main navigation form that displays several subforms. When I update a field on one of the subforms, I need to then search a particular field on the main form for any records in the main form's source table that referenced the pre-updated value and replace that value with the new value. After much searching, the code I works find to update *some* of the records it finds, but not all of them. It *finds* all of the records; it just can't update them all returning a 3188 error ("Could not update; currently locked by another session on this machine") on some. I've done quite a bit of searching and trying various things this morning, but I haven't been able to come up with anything that will stop this problem. Anyone have any ideas for me to try? Thanks for any suggestions.
If Not IsNull(Me.Replacing) Then
'Added Refresh and DoEvents per Google suggestions to get past useless error msg that data has changed. ??
Me.Refresh
DoEvents
Me.Parent.PhoneTreeCalledBy.Value = Me.Replacing_Selection.Column(3)
'Now loop thru tblStaffMembers. If PhoneTreeCalledBy = Replacing then make
'PhoneTreeCalledBy = me.Parent.PIDorUniqueID
If Me.Dirty = True Then
Me.Dirty = False
End If
strThisPersonPID = Me.Parent.PIDorUniqueID
strThisPersonName = Me.PreferredName
strPersonBeingReplaced = [Forms]![DataEntry_frmStaffMembers]![NavigationSubform]![DataEntry_sfrmStaffMembers_WorkDetails].[Form]![Replacing]
Set db = CurrentDb()
strSQL = "SELECT PhoneTreeCalledBy, PIDOrUniqueID, LastName FROM tblStaffMembers " & _
"WHERE PhoneTreeCalledBy = '" & strPersonBeingReplaced & "'"
Set rs = db.OpenRecordset(strSQL, dbDynaset)
Dim strStaffMemBeingUpdatedNow_PID As String
Dim strStaffMemBeingUpdatedNow_LName
'If there's a prob and the staff mem can't receive the update from the change,
'we need to display who didn't get changed so we can manually change that person's
'Emerg Caller
On Error GoTo PrintError
With rs
If .RecordCount <> 0 Then
rs.MoveLast
iCount = rs.RecordCount
Do While Not rs.BOF
strStaffMemBeingUpdatedNow_PID = !PIDorUniqueID
strStaffMemBeingUpdatedNow_LName = !LastName
[highlight #FCE94F].Edit <<<error 3188 occurs here[/highlight]
!PhoneTreeCalledBy = strThisPersonPID
.Update
.MovePrevious
Loop
End If
End With
rs.Close
Set db = Nothing
Set rs = Nothing
Else
Me.Parent.PhoneTreeCalledBy.Value = 999999999
MsgBox "Check the Phone Call Tree report to make sure everyone has the correct caller.", vbInformation, "Info Message"
End If
If Me.Dirty = True Then
Me.Dirty = False
End If
End If
Exit Sub
PrintError:
If Err.Number = 3188 Then
MsgBox "Err#: " & Err.Number & " " & Err.Description & vbLf & vbLf & _
"WRITE DOWN THIS PID" & vbLf & _
"You will need to manually update the Emerg Call Tree for " & _
strStaffMemBeingUpdatedNow_PID & " " & strStaffMemBeingUpdatedNow_LName & " to " & _
strThisPersonName & "'s PID."
Resume Next
Else
MsgBox "Err#: " & Err.Number & " " & Err.Description
Resume Next
End If
End Sub
If Not IsNull(Me.Replacing) Then
'Added Refresh and DoEvents per Google suggestions to get past useless error msg that data has changed. ??
Me.Refresh
DoEvents
Me.Parent.PhoneTreeCalledBy.Value = Me.Replacing_Selection.Column(3)
'Now loop thru tblStaffMembers. If PhoneTreeCalledBy = Replacing then make
'PhoneTreeCalledBy = me.Parent.PIDorUniqueID
If Me.Dirty = True Then
Me.Dirty = False
End If
strThisPersonPID = Me.Parent.PIDorUniqueID
strThisPersonName = Me.PreferredName
strPersonBeingReplaced = [Forms]![DataEntry_frmStaffMembers]![NavigationSubform]![DataEntry_sfrmStaffMembers_WorkDetails].[Form]![Replacing]
Set db = CurrentDb()
strSQL = "SELECT PhoneTreeCalledBy, PIDOrUniqueID, LastName FROM tblStaffMembers " & _
"WHERE PhoneTreeCalledBy = '" & strPersonBeingReplaced & "'"
Set rs = db.OpenRecordset(strSQL, dbDynaset)
Dim strStaffMemBeingUpdatedNow_PID As String
Dim strStaffMemBeingUpdatedNow_LName
'If there's a prob and the staff mem can't receive the update from the change,
'we need to display who didn't get changed so we can manually change that person's
'Emerg Caller
On Error GoTo PrintError
With rs
If .RecordCount <> 0 Then
rs.MoveLast
iCount = rs.RecordCount
Do While Not rs.BOF
strStaffMemBeingUpdatedNow_PID = !PIDorUniqueID
strStaffMemBeingUpdatedNow_LName = !LastName
[highlight #FCE94F].Edit <<<error 3188 occurs here[/highlight]
!PhoneTreeCalledBy = strThisPersonPID
.Update
.MovePrevious
Loop
End If
End With
rs.Close
Set db = Nothing
Set rs = Nothing
Else
Me.Parent.PhoneTreeCalledBy.Value = 999999999
MsgBox "Check the Phone Call Tree report to make sure everyone has the correct caller.", vbInformation, "Info Message"
End If
If Me.Dirty = True Then
Me.Dirty = False
End If
End If
Exit Sub
PrintError:
If Err.Number = 3188 Then
MsgBox "Err#: " & Err.Number & " " & Err.Description & vbLf & vbLf & _
"WRITE DOWN THIS PID" & vbLf & _
"You will need to manually update the Emerg Call Tree for " & _
strStaffMemBeingUpdatedNow_PID & " " & strStaffMemBeingUpdatedNow_LName & " to " & _
strThisPersonName & "'s PID."
Resume Next
Else
MsgBox "Err#: " & Err.Number & " " & Err.Description
Resume Next
End If
End Sub