Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations SkipVought on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

help with error handling code

Status
Not open for further replies.

gamisens

Technical User
Apr 29, 2001
15
0
0
US
I have a piece of code I got from a book that is supposed to handle multiuser record editing error. When I try to run it I get an error message “object doesn’t support this method or property” for this line of code:
If ctl <> RSC((ctl.ControlSource)) Then ....
As far as I understand, this is the line that is comparing the two recordsets so it is the most crucial piece to this code. Can someone pleas look over this code and tell me the way to correct it so it will work? Thank you.

Here is the code:

'*****************************************
' This routine will be called if there is
' a multiuser locking problem on a record.
' ChangeColor is the font color to be used to
' show the ChangedFields, and OriginalColor is
' the font color before the change.

Sub HandleLocks(ChangeColor As Long, OriginalColor As Long)
Dim ctl As Control
Dim MsgResponse As Integer, Msg As String
Dim ChangedFields As New Collection, CF As Control, _
CollectCount As Integer
Dim RS As Recordset
Dim RSC As Recordset

' Open the form's RecordsetClone.
Set RSC = Me.RecordsetClone

' Move the form's RecordsetClone to the current record.
' This also refreshes the underlying data to show
' stored changes made by another user.
RSC.Bookmark = Me.Bookmark

' Loop through the form controls to compare changes
' to bound fields.
For Each ctl In Me.Controls
' Look only at text fields, but you can include
' other control types that are bound in your routine.
If ctl.ControlType = acTextBox Then
' If the form values and the RecordsetClone values
' do not match, change the font of the text box
' to the ChangeColor variable.
' Also set the control's Tag property to the value
' in the RecordsetClone.
If ctl <> RSC((ctl.ControlSource)) Then
ctl.ForeColor = ChangeColor
ctl.Tag = RSC((ctl.ControlSource))
' Add changed controls to the ChangedFields
' collection to loop through later in the code.
ChangedFields.Add ctl
End If
End If
Next

MsgResponse = MsgBox(&quot;Someone has just changed this record.&quot; & _
&quot; You can choose YES to drop the changes you just made.&quot; & _
&quot; If you choose NO, you can compare values.&quot; & Chr(13) & _
Chr(13) & &quot; Drop your changes?&quot;, vbYesNo)

If MsgResponse = vbYes Then
' Your changes will be dropped.
' Loop through the ChangedFields collection.
For Each CF In ChangedFields
' Make the control's value equal to its
' Tag property.
CF = CF.Tag
' Change font color back to original.
CF.ForeColor = OriginalColor
' Clear the control's Tag property.
CF.Tag = &quot;&quot;
Next

' Clear the ChangedFields collection.
For CollectCount = ChangedFields.Count To 1 Step -1
ChangedFields.Remove CollectCount
Next CollectCount
' Exit this procedure; the other user's values
' have been saved.
Exit Sub
End If

' You decided to compare your changes with those of
' the other user.
For Each CF In ChangedFields
Msg = &quot;Change value of the &quot; & CF.Name & &quot; Field to&quot; & _
Chr(13) & CF.Tag
MsgResponse = MsgBox(Msg, vbYesNo)
If MsgResponse = vbYes Then
' You chose to discard your data for that field.
' Make the control's value equal to its
' Tag property.
CF = CF.Tag
' Change font color back to original.
CF.ForeColor = OriginalColor
' Clear the control's Tag property.
CF.Tag = &quot;&quot;
Else
' You chose to keep your data for that field.
' Open another recordset based on the form and
' move to that record.

' Because the underlying record source has already
' been changed by another user, you must open
' a new recordset and apply the values that
' you stored in the ChangedFields collection.

' This allows you to write back your values
' without causing locking errors on the form.

' In fact you are reediting the record and
' masking that fact through this code.
Set RS = CurrentDb.OpenRecordset((Me.RecordSource), _
dbOpenDynaset)
RS.MoveLast
RS.MoveFirst
' Set the new recordset position equal to the
' record on the form. If the form has a filter
' applied, you must also filter the new recordset.
RS.AbsolutePosition = Me.CurrentRecord - 1
RS.Edit
RS((CF.ControlSource)) = CF.Value
RS.Update
' Change font color back to original.
CF.ForeColor = OriginalColor
' Clear the control's Tag property.
CF.Tag = &quot;&quot;
End If
Next

' Clear the ChangedFields collection.
For CollectCount = ChangedFields.Count To 1 Step -1
ChangedFields.Remove CollectCount
Next CollectCount

End Sub

This is the way the sub is called:

Private Sub Form_Error(DataErr As Integer, Response As Integer)
Dim MsgResponse As Integer

' Trap for Locking errors on the form.
If (DataErr >= 3187 And DataErr <= 3262) _
Or DataErr = 7787 Or DataErr = 3167 Then
' Suppress the Microsoft Access User Interface
' Message Box by letting Response = 0.
Response = 0
If DataErr = 3167 Then
' The record has been deleted
' by another user.
' Undo the Save Record action.
DoCmd.DoMenuItem 0, 1, 0, 0, acMenuVer70
MsgResponse = MsgBox(&quot;Record has been deleted&quot; & _
&quot; by another user, refresh records?&quot;, vbYesNo)
' If the user selects No, the form will not
' requery and the user will see #Deleted in the
' controls of the deleted record.
If MsgResponse = vbYes Then
Me.Requery
End If
Exit Sub
End If
' Call Locking Routine to drop your changes
' and accept the other user's, or compare the other
' user's changes and select the values to keep.
Call HandleLocks(255, 0)
End If
End Sub
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top