Updating a database using a disconnected recordset

Option Explicit

'Purpose : Open a disconnected recordset.
'Inputs : oCon The connection to open the recordset on.
' sSQL The SQL to open the recordset with.
' oRS The resulting recordset.
'Outputs : Returns True if the recordset was opened and contained results.


Public Function RSOpenDisconnected(oCon As ADODB.Connection, sSQL As String, oRS As ADODB.Recordset, Optional eLocking As LockTypeEnum = adLockBatchOptimistic) As Boolean
On Error GoTo ErrFailed
If oCon.State = adStateOpen Then
'Connection is open
Set oRS = New ADODB.Recordset
'Set cursor to client (i.e. Local Machine)
oRS.CursorLocation = adUseClient
'Open Recordset (NB. The CursorType is always "adOpenStatic" for client-side cursors)
oRS.Open sSQL, oCon, adOpenStatic, eLocking
'Set connection to nothing (disconnect recordset)
Set oRS.ActiveConnection = Nothing
If oRS.EOF = False Then
'Return results
RSOpenDisconnected = True
Else
'Empty recorset
RSOpenDisconnected = False
End If
End If
Exit Function

ErrFailed:
Debug.Print "Failed to open recordset: " & Err.Description
Debug.Assert False 'Error occurred
RSOpenDisconnected = False
On Error GoTo 0
End Function


'Demonstrates how to open a disconnected recordset and then update a value in
'a field in the database.
Sub Test()
Dim oRS As ADODB.Recordset
Dim oConn As ADODB.Connection
Const clRecordUpdated As Long = -2147217864

On Error GoTo ErrUpdateFailed
'Open a connection to a database
Set oConn = New ADODB.Connection
oConn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\MyPath\MyDatabase.mdb; Persist Security Info=False"
'Open a disconnected recordset
RSOpenDisconnected oConn, "Select * from tblHoliday", oRS
'Update a field in the recordset
oRS.Fields("MyField").Value = "My New Value"
'Reconnect to database
Set oRS.ActiveConnection = oConn

'Update table
oRS.UpdateBatch

'Close the connection
oRS.Close
Set oRS = Nothing
oConn.Close
Set oConn = Nothing

Exit Sub

ErrUpdateFailed:
If Err.Number = clRecordUpdated Then
MsgBox "The record you altered has been altered by another user... " & vbNewLine & Err.Description, vbCritical
Else
MsgBox "Error in disconnected update routine... " & vbNewLine & Err.Description, vbCritical
End If
End Sub