copy a current record and its subitems too

[JumpinJimRivers]

I need to copy a current record and its subitems to a new record and new subitems. But I can't figure out how to use the old record ID as the criteria to copy the right subitems but also get the new record's ID as the subitems' new foreign key so they will relate to the new record and not the old record. Make sense anybody?

 

[ARJakhu]

I would really like to know how to do this too.......anyone?

 

[JumpinJimRivers]

ARJakhu, glad to know I'm not the only one. You may be interested in the code below that I found from another thread by someone who already had a method (the code below) but was looking for a more efficient way. I haven't played with it enough to get it to work yet but you may want to try it out.

Good luck!
-Blaine



Sub AppendRelatedRecords()
Dim db As Database
Dim recSourceMain As Recordset
Dim recSourceSub As Recordset
Dim recDestMain As Recordset
Dim recDestSub As Recordset
Dim NewKeyVal As Long
'change sqlSourceMaindata to a query to your data source
Set db = OpenDatabase("YourDBName&quot
Set recSourceMain = db.OpenRecordset("SELECT * FROM sqlSourceMaindata", dbOpenForwardOnly)
'change sqlDestMaindata is to query to your data dest
Set recDestMain = db.OpenRecordset("SELECT * FROM sqlDestMaindata", dbOpenDynaset)
'change sqlDestSubdata is a query to your data dest
Set recDestSub = db.OpenRecordset("SELECT * FROM sqlDestSubdata", dbOpenDynaset)
'do this for each main record to be copied
Do While Not recSourceMain.EOF
'change sqlSourceSubdata to a query to your data source
Set recSourceSub = db.OpenRecordset("SELECT * FROM sqlSourceSubdata WHERE KeyName = " & recSourceMain!KeyName, dbOpenForwardOnly)
CopyRecord NewKeyVal, "KeyName", recSourceMain, recDestMain
'do this for each sub record to be copied
Do While Not recSourceSub.EOF
CopyRecord "", "", recSourceSub, recDestSub
recSourceSub.MoveNext
Loop
recSourceMain.MoveNext
Loop
recDestSub.Close
recDestMain.Close
recSourceMain .Close
Set recDestMain = Nothing
Set recDestSub = Nothing
Set recSourceMain = Nothing
Set recSourceSub = Nothing
db.Close
Set db = Nothing
End Sub

Sub CopyRecord(NewKey As Long, KeyName As String, recCopyFrom As Recordset, recCopyTo As Recordset)
Dim i As Integer
recCopyTo.AddNew
'enumerate the fields
For i = 0 To recCopyTo.Fields.count - 1
'if the field is the autonumber keyfield then remember the new Keyname
If recCopyTo.Fields(i).name = KeyName Then
NewKey = recCopyTo(KeyName).Value
Else 'copy over the data
recCopyTo(recCopyFrom.Fields(i).name).Value = recCopyFrom.Fields(i).Value
End If
Next
recCopyTo.Update
End Sub