Article ID: 206175
Article Last Modified on 6/23/2005
Response = acDataErrContinueMicrosoft provides programming examples for illustration only, without warranty either expressed or implied. This includes, but is not limited to, the implied warranties of merchantability or fitness for a particular purpose. This article assumes that you are familiar with the programming language that is being demonstrated and with the tools that are used to create and to debug procedures. Microsoft support engineers can help explain the functionality of a particular procedure, but they will not modify these examples to provide added functionality or construct procedures to meet your specific requirements.
Option Explicit
Public Function SaveRecODBC (SRO_form As Form) As Boolean
'***************************************************************
'Function: SaveRecODBC
'
'Purpose: Updates a form based on a linked ODBC table
' and traps any ODBC errors.
'
'Arguments: SRO_Form, which refers to the form.
'
'
'Returns: True if successful or False if an error occurs.
'***************************************************************
On Error GoTo SaveRecODBCErr
Dim fld As Field, ctl As Control
Dim errStored As Error
Dim rc As DAO.Recordset
' Check to see if the record has changed.
If SRO_form.Dirty Then
Set rc = SRO_Form.Recordset.Clone
If SRO_form.NewRecord Then
rc.AddNew
For Each ctl In SRO_form.Controls
' Check to see if it is the type of control
' that has a ControlSource.
If ctl.ControlType = acTextBox Or _
ctl.ControlType = acComboBox Or _
ctl.ControlType = acListBox Or _
ctl.ControlType = acCheckBox Then
' Verify that a value exists in the ControlSource.
If ctl.Properties("ControlSource") <> "" Then
' Loop through the fields collection in the
' RecordsetClone. If you find a field name
' that matches the ControlSource, update the
' field. If not, skip the field. This is
' necessary to account for calculated controls.
For Each fld In rc.Fields
' Find the field and verify
' that it is not Null.
' If it is Null, don't add it.
If fld.Name = ctl.Properties("ControlSource") _
And Not IsNull(ctl) Then
fld.Value = ctl
' Exit the For loop
' if you have a match.
Exit For
End If
Next fld
End If ' End If ctl.Properties("ControlSource")
End If ' End If ctl.controltype
Next ctl
rc.Update
Else
' This is not a new record.
' Set the bookmark to synchronize the record in the
' RecordsetClone with the record in the form.
rc.Bookmark = SRO_form.Bookmark
rc.Edit
For Each ctl In SRO_form.Controls
' Check to see if it is the type of control
' that has a ControlSource.
If ctl.ControlType = acTextBox Or _
ctl.ControlType = acComboBox Or _
ctl.ControlType = acListBox Or _
ctl.ControlType = acCheckBox Then
' Verify that a value exists in the
' ControlSource.
If ctl.Properties("ControlSource") <> "" Then
' Loop through the fields collection in the
' RecordsetClone. If you find a field name
' that matches the ControlSource, update the
' field. If not, skip the field. This is
' necessary to account for calcualted controls.
For Each fld In rc.Fields
' Find the field and make sure that the
' value has changed. If it has not
' changed, do not perform the update.
If fld.Name = ctl.Properties("ControlSource") _
And fld.Value <> ctl And _
Not IsNull(fld.Value <> ctl) Then
fld.Value = ctl
' Exit the For loop if you have a match.
Exit For
End If
Next fld
End If ' End If ctl.Properties("ControlSource")
End If ' End If ctl.controltype
Next ctl
rc.Update
End If ' End If SRO_form.NewRecord
End If ' End If SRO_form.Dirty
' If function has executed successfully to this point then
' set its value to True and exit.
SaveRecODBC = True
Exit_SaveRecODBCErr:
Exit Function
SaveRecODBCErr:
' The function failed because of an ODBC error.
' Below are a list of some of the known error numbers.
' If you are not receiving an error in this list,
' add that error to the Select Case statement.
For Each errStored In DBEngine.Errors
Select Case errStored.Number
Case 3146
' No action -- standard ODBC--Call failed error.
Case 2627
' Error caused by duplicate value in primary key.
MsgBox "You tried to enter a duplicate value " & _
"in the Primary Key."
Case 3621
' No action -- standard ODBC command aborted error.
Case 547
' Foreign key constraint error.
MsgBox "You violated a foreign key constraint."
Case Else
' An error not accounted for in the Select Case
' statement.
On Error Goto 0
Resume
End Select
Next errStored
SaveRecODBC = False
Resume Exit_SaveRecODBCErr
End Function
Sub Form_BeforeUpdate (Cancel As Integer)
' If you can save the changes to the record,
' undo the changes on the form.
If SaveRecODBC(Me) Then
Me.Undo
' If this is a new record, go to the last record on
' the form.
If Me.NewRecord Then
RunCommand acCmdRecordsGoToLast
End If
Else
' If you can't update the record, cancel
' the BeforeUpdate event.
Cancel = -1
End If
End Sub
Additional query words: pra trapping can t
Keywords: kbbug kbnofix kbdatabase KB206175