Deep Copy or Clone an ADODB recordset in VBA

Question

I have been searching for a way of duplicating or copying a recordset in VBA. And by that I mean, having the undelying data independent of each other.

I have tried

Set copyRS = origRS.Clone
Set copyRS = origRS

When I use any of the methods I cant modify one recordset without modifying the other. So in this example:

1. I create a recordset
2. I populate the recordset with the name John
3. I clone the recordset
4. I modify the cloned one
5. Check result

Code:

Dim origRS As Recordset, copyRS As Recordset
Set origRS = New Recordset
'Create field
origRS.Fields.Append "Name", adChar, 10, adFldUpdatable
origRS.Open
'Add name
origRS.AddNew "Name", "John"
'Clone/copy
Set copyRS = origRS.Clone
'Change record in cloned/copied recordset
copyRS.MoveFirst
copyRS!Name = "James"
'This should give me "JamesJohn"
MsgBox copyRS.Fields(0).Value & origRS.Fields(0)

But unfortunately for me, this modifies both recordsets

My question is:

Is there a way of copying a recordset from another recordset and then modify the data independently of each other (without looping)?

I know that evidently you can do it through a loop, but is there no other way?

Answer 1

++ Good question! btw. this way of copying object is called a deep copy.

I usually get away with creating an ADODB.Stream and saving the current recordset into it.

Then you can use the .Open() method of a new recordset and pass the stream to it.

For example:

Sub Main()

    Dim rs As ADODB.Recordset
    Set rs = New ADODB.Recordset

    rs.Fields.Append "Name", adChar, 10, adFldUpdatable
    rs.Open
    rs.AddNew "Name", "John"

    Dim strm As ADODB.Stream
    Set strm = New ADODB.Stream

    rs.Save strm

    Dim copy As New ADODB.Recordset
    copy.Open strm

    copy!Name = "hellow"

    Debug.Print "orignal recordset: " & rs.Fields(0).Value
    Debug.Print "copied recordset: " & copy.Fields(0).Value

    strm.Close
    rs.Close
    copy.Close

    Set strm = Nothing
    Set rs = Nothing
    Set copy = Nothing

End Sub

Results as expected: