Copy / Duplicate Records & Sub-Records

I am having difficulty posting my whole question & attachments, so I am going to try to break this question up in sections.

Basically, what I need is for the user to click a button on the Main form that will duplicate/copy all the fields in that record & all the fields in the associated sub-records (so the parent record & all child records).

The issue that I am running into is that the sub-records have sub-records of their own, & those also need to be copied (so the “grandchildren” are causing a problem).
t_hillAsked:
Who is Participating?
 
dqmqCommented:
Now that my credibility is totally shot, I'll give it another go.   This is all done in notepad, so there are undoubtedly some syntax errors and possibly some logic flaws.  But, I think the idea will come across.  Basically, I am trying to steer you toward using recordsets because the mechanism for retrieving the last autonumber is more reliable and it gives you a way to retrieve the autonumbers of the child records inside of a nested loop.  


Private Sub cmd_Duplicate_All_Click()

'Declare variables.
Dim db As Database
Dim rec  As Recordset
Dim rec1 As Recordset
Dim newM As Recordset
Dim newA As Recordset
Dim newB As Recordset
Dim newBB As Recordset

Dim strSQL As String
Dim strSQL1 As String
Dim strSQL2 As String
Dim strSQL3 As String
Dim strSQL4 As String
Dim strSQL5 As String
Dim strSQL6 As String
Dim strSQL7 As String
Dim strSQL8 As String
Dim strSQL9 As String
Dim strSQL10 As String
Dim strSQL11 As String
Dim strSQL12 As String
Dim strSQL13 As String
Dim strSQL14 As String
Dim strSQL15 As String
Dim strSQL16 As String
Dim strSQL17 As String
Dim strSQL18 As String
Dim strSQL19 As String

Dim NewSubID As Long

Set db = CurrentDb()
Set newM = db.OpenRecordset("tbl_Main")
Set newA = db.OpenRecordset("tbl_sub_A")
Set newB = db.OpenRecordset("tbl_sub_B")
Set newB = db.OpenRecordset("tbl_subsub_BB")



'locate main record to be copied
Set rec = db.OpenRecordset("select * from tbl_Main where Main_ID_PK=" & Me.Main_ID_PK)


'Insert record into Main table.
with newM
  .addnew
  !Field_01 = rec!Field_01
  !Field_02 = rec!Field_01
  !Field_03 = rec!Field_01
  !Field_04 = rec!Field_01
  !Field_05 = rec!Field_01
  .update
  .Move 0, .LastModified 
end with
rec.close


with newA
   'locate sub a records to be copied
   Set rec = db.OpenRecordset("select * from tbl_sub_A where Main_ID_FK=" & Me.Main_ID_PK)
   rec.movefirst 
   do while not rec.bof and not rec.eof
      .addnew
      ![aField_01]=rec![aField_01]
      ![aField_02]=rec![aField_02]
      ![Main_ID_FK]=newM.[Main_ID_PK]
      .update
      rec.movenext
   loop 
end with



with newB
   'locate sub b records to be copied
   Set rec = db.OpenRecordset("select * from tbl_sub_B where Main_ID_FK=" & Me.Main_ID_PK)
   rec.movefirst 
   do while not rec.bof and not rec.eof
      .addnew
      ![aField_01]=rec![aField_01]
      ![aField_02]=rec![aField_02]
      ![Main_ID_FK]=newM![Main_ID_PK]
      .update
      .Move 0, .LastModified 
      Set rec1 = db.OpenRecordset("select * from tbl_subsub_BB where B_ID_FK=" & rec!B_ID_PK)
      rec1.movefirst
      do while not rec1.bof and not rec1.eof
         newBB.addnew
         newBB![bbField_01]=rec1![bbField_01]
         newBB![bbField_02]=rec1![bbField_02]
         newBB![B_ID_FK]=newB!B_ID_PK
         newBB.update
         rec1.movenext
      loop  
      rec.movenext
   loop 
end with

rec.close
rec1.close
newA.close
newB.close
newBB.close

'Refreshes the data on the form.
Me.Requery

'Puts focus on newly created Contract record (the last record).
DoCmd.RunCommand acCmdRecordsGoToLast

End Sub

Open in new window

0
 
t_hillAuthor Commented:
Below is an example of my table information:

PK = Primary Key / Unique Identifier (this example they are autonumbers)
FK = Foreign Key

Main Table
(tbl_Main)
Main_ID_PK
Field_01
Field_02
Field_03
Field_04
Field_05

Sub Table A
(tbl_sub_A)
A_ID_PK
Main_ID_FK
aField_01
aField_02

Sub Table B
(tbl_sub_B)
B_ID_PK
Main_ID_FK
bField_01
bField_02

Sub-Sub Table BB
(tbl_subsub_BB)
BB_ID_PK
B_ID_FK
bbField_01
bbField_02
0
 
t_hillAuthor Commented:
Below is an example of my code:
 
'The 1st 2 lines (Option Explicit & Option Compare Database) are at the beginning of the module
Option Explicit
Option Compare Database

Private Sub cmd_Duplicate_All_Click()

'Declare variables.
Dim db As Database
Dim rec As Recordset
Dim rec2 As Recordset

Dim strSQL As String
Dim strSQL1 As String
Dim strSQL2 As String
Dim strSQL3 As String
Dim strSQL4 As String
Dim strSQL5 As String
Dim strSQL6 As String
Dim strSQL7 As String
Dim strSQL8 As String
Dim strSQL9 As String
Dim strSQL10 As String
Dim strSQL11 As String
Dim strSQL12 As String
Dim strSQL13 As String
Dim strSQL14 As String
Dim strSQL15 As String
Dim strSQL16 As String
Dim strSQL17 As String
Dim strSQL18 As String
Dim strSQL19 As String

Dim NewMainID As Long
Dim OldMainID As Long
Dim NewSubID As Long

Set db = CurrentDb()
Set rec = db.OpenRecordset("tbl_Main")
Set rec2 = db.OpenRecordset("tbl_sub_B")

'Store Main "to be copied" record's primary key in variable.
OldMainID = Me.Main_ID_PK

'Insert record into Main table.
strSQL1 = "INSERT INTO tbl_Main (Field_01, Field_02, Field_03, Field_04, Field_05) "
strSQL2 = "Select tbl_Main.Field_01, tbl_Main.Field_02, tbl_Main.Field_03, tbl_Main.Field_04, "tbl_Main.Field_05 "
strSQL4 = "FROM tbl_Main WHERE (((Main_ID_PK)=" & OldMainID & "));"
strSQL = strSQL1 & strSQL2 & strSQL4
db.Execute strSQL, dbFailOnError

With rec
.MoveFirst
.MoveLast
End With

'Store newly created Main table record's primary key in variable.
NewMainID = rec("Main_ID_PK")

'Insert records into Sub Table A.
strSQL5 = "INSERT INTO tbl_sub_A ( [aField_01], [aField_02], Main_ID_FK) "
strSQL6 = "SELECT tbl_sub_A.[aField_01], tbl_sub_A.[aField_02], "
strSQL7 = [NewMainID]
strSQL8 = " FROM [tbl_sub_A] WHERE (((tbl_sub_A.Main_ID_FK)=" & OldMainID & "));"
strSQL9 = strSQL5 & strSQL6 & strSQL7 & strSQL8
db.Execute strSQL9, dbFailOnError

'Insert records into Sub Table B.
strSQL10 = "INSERT INTO tbl_sub_B ( [bField_01], [bField_02], Main_ID_FK) "
strSQL11 = "SELECT tbl_sub_B.[bField_01], tbl_sub_B.[bField_02], "
strSQL12 = [NewMainID]
strSQL13 = " FROM [tbl_sub_B] WHERE (((tbl_sub_B.Main_ID_FK)=" & OldMainID & "));"
strSQL14 = strSQL10 & strSQL11 & strSQL12 & strSQL13
db.Execute strSQL14, dbFailOnError

With rec2
.MoveFirst
.MoveLast
End With

'Store newly created Invoice record's primary key in variable.
NewSubID = rec2("B_ID_PK")

'Insert records into Sub-Sub Table BB.
strSQL15 = "INSERT INTO tbl_subsub_BB( [bbField_01], [bbField_02], B_ID_FK) "
strSQL16 = "SELECT tbl_subsub_BB.[bbField_01], tbl_subsub_BB.[bbField_02], "
strSQL17 = [NewSubID]
strSQL18 = " FROM (tbl_Main LEFT JOIN tbl_sub_B ON tbl_Main.Main_ID_PK = tbl_sub_B.Main_ID_FK) LEFT JOIN tbl_subsub_BB ON tbl_sub_B.B_ID_PK = tbl_subsub_BB.B_ID_FK WHERE (((tbl_Main.Main_ID_PK)=" & OldMainID & "));"
strSQL19 = strSQL15 & strSQL16 & strSQL17 & strSQL18
db.Execute strSQL19, dbFailOnError

'Refreshes the data on the form.
Me.Requery

'Puts focus on newly created Contract record (the last record).
DoCmd.RunCommand acCmdRecordsGoToLast

End Sub

Open in new window

0
Ultimate Tool Kit for Technology Solution Provider

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy now.

 
t_hillAuthor Commented:
This works fine when the relationship between the Parent table & the Child table is 1:1.  But if the relationship between the Parent table & the Child table is 1:many, then the Grandchild table entries are incorrect.

I can see why this is happening.  The NewSubID being inserted into the B_ID_FK field for all copied Grandchild records is using the same number (so all the newly created Sub Sub BB records are being associated with just one newly created Sub B record).  Since there is more than one record being added to the Sub Table B, there should be more than one number B_ID_FK used.

I believe the problem is starting at “Insert records into Sub Table B”.  I think this needs to be looped through so the individual NewSubID’s are captured.  Bear with me here… so the process would be:

1. Grab the 1st Sub Table B record to be copied (OldSubID).

2. Copy it’s info into the new Sub Table B record & store it’s ID (NewSubID).

3. Grab all the Sub-Sub Table BB’s record using the OldSubID & copy the entries using the NewSubID.

4. Loop back to grab the 2nd Sub Table B record to be copied (OldSubID updated) & go through the process again until EOF (end of file) / no more Sub Table B records to copy for the Main table.

I am unsure how to code this in VBA.  Any assistance is greatly appreciated.
0
 
dqmqCommented:
I too, will answer in sections.

First this code is unreliable:

With rec
.MoveFirst
.MoveLast
End With

'Store newly created Main table record's primary key in variable.
NewMainID = rec("Main_ID_PK")


Please change to this:

.Move 0, .LastModified ' [1]
'Store newly created Main table record's primary key in variable.
NewMainID = rec("Main_ID_PK")


While you are doing that I will work on your recursive loops

0
 
dqmqCommented:
Correction: Please change to this:

rec.Move 0, rec.LastModified ' [1]
'Store newly created Main table record's primary key in variable.
NewMainID = rec!Main_ID_PK


And later on:
rec2.Move 0, rec2.LastModified ' [1]
'Store newly created child table record's primary key in variable.
NewMainID = rec2!B_ID_PK

0
 
dqmqCommented:
I'm sorry, stop.  In my rush to get out a quick answer, I've mis-led you.  This will be a complicated re-write, so let me get back to you soon
0
 
t_hillAuthor Commented:
Ok.  :)   Thanks.
0
 
t_hillAuthor Commented:
Thank you for responding so quickly.  Let me work with what you gave me & will post back.
0
 
dqmqCommented:
Also, I caution you that my code is devoid of any error handling, so that will need to be added.  And...the entire procedure should be inside a transaction so that the copy either succeeds or fails as a whole.  
0
 
t_hillAuthor Commented:
That worked great!  Thanks!!

I will work on the error handling.
0
 
t_hillAuthor Commented:
Great solution!  And very fast response.  :)
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.