Глубокое копирование или клонирование набора записей ADODB в VBA

Я искал способ дублирования или копирования набора записей в VBA. И под этим я имею в виду, что данные, не зависящие друг от друга, не зависят друг от друга.

Я пробовал

Set copyRS = origRS.Clone
Set copyRS = origRS

Когда я использую любой из методов, я не могу изменить один набор записей без изменения другого. Итак, в этом примере:

  • Я создаю набор записей
  • Я заполняю набор записей именем John
  • Я клонирую набор записей
  • Я изменяю клонированный
  • Проверить результат

код:

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)

Но, к сожалению, для меня это изменяет оба набора записей

Мой вопрос:

Есть ли способ копирования набора записей из другого набора записей, а затем изменять данные независимо друг от друга (без циклов)?

Я знаю, что, очевидно, вы можете сделать это через цикл, но другого пути нет?

Ответы

Ответ 1

++ Хороший вопрос! Кстати. этот способ копирования объекта называется глубокой копией.

Обычно мне удается создать ADODB.Stream и сохранить в нем текущий набор записей.

Затем вы можете использовать метод .Open() нового набора записей и передать ему поток.

Например:

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

Ожидаемые результаты:

enter image description here