OriginalValue and UnderlyingValue Properties Example (VB)
This example demonstrates the OriginalValue and UnderlyingValue properties by displaying a message if a record's underlying data has changed during a Recordset batch update.
'BeginOriginalValueVB
Public Sub Main()
On Error GoTo ErrorHandler
'To integrate this code
'replace the data source and initial catalog values
'in the connection string
Dim Cnxn As ADODB.Connection
Dim rstTitles As ADODB.Recordset
Dim fldType As ADODB.Field
Dim strCnxn As String
Dim strSQLTitles As String
' Open connection.
Set Cnxn = New ADODB.Connection
strCnxn = "Provider='sqloledb';Data Source='MySqlServer';" & _
"Initial Catalog='Pubs';Integrated Security='SSPI';"
Cnxn.Open strCnxn
' Open recordset for batch update
' using object refs to set properties
Set rstTitles = New ADODB.Recordset
Set rstTitles.ActiveConnection = Cnxn
rstTitles.CursorType = adOpenKeyset
rstTitles.LockType = adLockBatchOptimistic
strSQLTitles = "titles"
rstTitles.Open strSQLTitles
' Set field object variable for Type field
Set fldType = rstTitles!Type
' Change the type of psychology titles
Do Until rstTitles.EOF
If Trim(fldType) = "psychology" Then
fldType = "self_help"
End If
rstTitles.MoveNext
Loop
' Simulate a change by another user by updating
' data using a command string
Cnxn.Execute "UPDATE Titles SET type = 'sociology' " & _
"WHERE type = 'psychology'"
'Check for changes
rstTitles.MoveFirst
Do Until rstTitles.EOF
If fldType.OriginalValue <> fldType.UnderlyingValue Then
MsgBox "Data has changed!" & vbCr & vbCr & _
" Title ID: " & rstTitles!title_id & vbCr & _
" Current value: " & fldType & vbCr & _
" Original value: " & _
fldType.OriginalValue & vbCr & _
" Underlying value: " & _
fldType.UnderlyingValue & vbCr
End If
rstTitles.MoveNext
Loop
' Cancel the update because this is a demonstration
rstTitles.CancelBatch
' Restore original values
Cnxn.Execute "UPDATE Titles SET type = 'psychology' " & _
"WHERE type = 'sociology'"
' clean up
rstTitles.Close
Cnxn.Close
Set rstTitles = Nothing
Set Cnxn = Nothing
Exit Sub
ErrorHandler:
' clean up
If Not rstTitles Is Nothing Then
If rstTitles.State = adStateOpen Then rstTitles.Close
End If
Set rstTitles = Nothing
If Not Cnxn Is Nothing Then
If Cnxn.State = adStateOpen Then Cnxn.Close
End If
Set Cnxn = Nothing
If Err <> 0 Then
MsgBox Err.Source & "-->" & Err.Description, , "Error"
End If
End Sub
'EndOriginalValueVB
See Also
OriginalValue Property (ADO)
Recordset Object (ADO)
UnderlyingValue Property