RE: Duplicate Data in Form, its Subform and SubSubForm

Tech-Archive recommends: Fix windows errors by optimizing your registry

This was an interesting problem..... I had never had to duplicate related
records from three tables.....

OK, here are the tables:

The one the many
---------------------------
table1 ----> table2
table2 ----> table3

lets assume there is one record in table1 and 5 records in table2. And for
each record in table2 there are 5 records in table3. So table1 has 1 record,
table2 has 5 records and table3 has 25 records. We will need to duplicate a
total of 31 records.

Table1 is easy - use the recordsetclone and add a new record (like you did).
But table2 requires two recordsets -one that is the records to be duplicated
and the another to add the new records and get the new FK. Table3 needs one
recordset.

In the code you will have to add the fields to the recordsets (many places)
if you want the values copied. If you will set the field to NULL after
copying the record, don't include the field in the recordset.

Use the proper delimiters - and you cannot copy a field if it is NULL.

I tried to use your names - but remember, you will have to add the field
names.

I used the .AddNew/ .Update construct for table1 and table2. For table3 I
used "INSERT INTO" syntax. It should be easy to switch it to .AddNew/ .Update
if you want.

!!!! Try this on a COPY of you database !!!
--watch for line wrap--

'----------code Beg------------
Private Sub Label22_Click()
On Error GoTo Err_Handler
'Purpose: Duplicate the main form record and related records in the
subform.
Dim db As DAO.Database

Dim rstT2 As DAO.Recordset 'tblControlSeccao
Dim rstT2A As DAO.Recordset 'tblControlSeccao
Dim rstT3 As DAO.Recordset 'tblControlAtrigo

Dim lngT1PK As Long ' current PK table1
Dim lngT2PK As Long ' current PK table2

Dim lngT1NewFK As Long ' new FK table1
Dim lngT2NewFK As Long ' new FK table2

Dim strSQL As String
Dim strSql_S As String 'SQL statement.
Dim strSql_A As String 'SQL statement.
Dim msg As String

'records added
Dim intRC_CD As Integer 'tblControlData
Dim intRC_CS As Integer 'tblControlSeccao
Dim intRC_CA As Integer 'tblControlAtrigo

'Save and edits first
If Me.Dirty Then
Me.Dirty = False
End If

Set db = CurrentDb

'Make sure there is a record to duplicate.
If Me.NewRecord Then
MsgBox "Select the record to duplicate."
Else
'Duplicate the main record: add to form's clone.
' in TBLCONTROLDATA 1st table
lngT1PK = Me.ControlDataID

With Me.RecordsetClone
.AddNew
'#### add fields/values here
'enter only the field values you want to duplicate
'example
' !ControlDataDe = Me.ControlDataDe
' !ControlDataA = Me.ControlDataA
'etc for other fields.
.Update

intRC_CD = intRC_CD + 1

'Save the primary key value,
'to use as the foreign key for the related records.
.Bookmark = .LastModified
lngT1NewFK = !ControlDataID
End With

'Duplicate the related records in TBLCONTROLSECCAO
' 2nd table

'#### add fields here
' select all records in tblControlSeccao
strSql_S = " SELECT SeccaoID, Seccao,ControlDataID"
strSql_S = strSql_S & " FROM [tblControlSeccao];"
Set rstT2A = db.OpenRecordset(strSql_S)

'#### add fields here
'select the records to duplicate
strSql_S = " SELECT SeccaoID, Seccao"
strSql_S = strSql_S & " FROM [tblControlSeccao]"
strSql_S = strSql_S & " WHERE ControlDataID = " & lngT1PK & ";"
Set rstT2 = db.OpenRecordset(strSql_S)

'check for empty recordset
If Not rstT2.BOF And Not rstT2.EOF Then
rstT2.MoveLast
rstT2.MoveFirst

Do While Not rstT2.EOF
'save PK
lngT2PK = rstT2!SeccaoID

'add new record
With rstT2A
'#### add fields/values here
' Values are from recordset "rstT2"
.AddNew
!ControlDataID = lngT1NewFK
!Seccao = Nz(rstT2!Seccao, "") '<- cannot be null
'etc for other fields.
.Update

intRC_CS = intRC_CS + 1

'get new PK
.Bookmark = .LastModified
lngT2NewFK = !SeccaoID ' new PK
End With

'now get the old records from table 3 and dup them
'Duplicate the related records in tblControlSeccao (3rd table)

'#### add fields here
strSql_A = "SELECT ArtigoID, Artigo, PrecoCIVA"
strSql_A = strSql_A & " FROM [tblControlArtigo]"
strSql_A = strSql_A & " WHERE SeccaoID = " & lngT2PK & ";"

Set rstT3 = db.OpenRecordset(strSql_A)

'check for empty recordset
If Not rstT3.BOF And Not rstT3.EOF Then
rstT3.MoveLast
rstT3.MoveFirst

Do While Not rstT3.EOF
'#### add fields here
strSQL = "INSERT INTO tblControlArtigo (Artigo, PrecoCIVA"
strSQL = strSQL & ", SeccaoID"
' strSQL = strSQL & ", Field1, field2, Field3, Field4"
strSQL = strSQL & ")"
strSQL = strSQL & " VALUES ('" & Nz(rstT3!Artigo, "") &
"', " & Nz(rstT3!PrecoCIVA, 0)
strSQL = strSQL & ", " & lngT2NewFK

'#### add values here
'other fields - USE proper delimiters!!!!
' strSQL = strSQL & " VALUES " & rstT3!Field1 & ", " &
rstT3!Field2
' strSQL = strSQL & rstT3!Field3 & ", " & rstT3!Field4
strSQL = strSQL & ");"

'insert record
db.Execute strSQL, dbFailOnError

intRC_CA = intRC_CA + 1

rstT3.MoveNext
Loop
rstT3.Close
End If
rstT2.MoveNext
Loop
rstT2.Close
rstT2A.Close
End If
End If

'Display the new duplicate.
' Me.sbfrmControl.Visible = False
' Me.sbsbfrmControl.Visible = False
' Me.sbsbsbfrmControl.Visible = False
' Me.Label17.Visible = False
' Me.Label23.Visible = True
' Me.ControlDataDe.Locked = False
' Me.ControlDataA.Locked = False
' Me.ControlDataDe.Value = Null
' Me.ControlDataA.Value = Null

'tell me when done
msg = intRC_CD & " record added to tblControlData"
msg = msg & vbCrLf & vbCrLf
msg = msg & intRC_CS & " record(s) added to tblControlSeccao"
msg = msg & vbCrLf & vbCrLf
msg = msg & intRC_CA & " record(s) added to tblControlAtrigo"
msg = msg & vbCrLf & vbCrLf
msg = msg & "Total records added = " & intRC_CD + intRC_CS + intRC_CA
MsgBox msg

Exit_Handler:
On Error Resume Next
Set rstT3 = Nothing
Set rstT2 = Nothing
Set rstT2A = Nothing
Set db = Nothing
Exit Sub

Err_Handler:
MsgBox "Error " & Err.Number & " - " & Err.Description, , "Label22_Click"
Resume Exit_Handler

End Sub
'----------code End------------


HTH
--
Steve S
--------------------------------
"Veni, Vidi, Velcro"
(I came; I saw; I stuck around.)


"Odeh Naber" wrote:

Hiya folks!

Heres the problem:

I have three tables. The first table is related to second table (one-
to-many) and the second table is related to the third table (one-to-
many). I built a form/subform/subsubform based on these tables.

I have been successful at duplicating the record from the form and
subform into a new record - but I have not been able to find a way to
also duplicate the data from the subsubform into the new record.

Here are the tables that I have (sorry it is not in english so I added
some translation to help):

TBLCONTROLDATA - tblcontroldates
ControlDataID - controldateid
ControlDataDe - controldatefrom
ControlDataA - controldateto

TBLCONTROLSECCAO - tblcontrolsection
SeccaoID - sectionid
Seccao - section
ControlDataID - controldateid

TBLCONTROLARTIGO - tblcontrolproduct
ArtigoID - productid
Artigo - product
PrecoCIVA - priceinludingtax
SeccaoID - sectionid

Here is the code I have on the button that is used to duplicate the
currently selected record:

'On Error GoTo Err_Handler
'Purpose: Duplicate the main form record and related records in
the subform.
Dim strSql As String 'SQL statement.
Dim lngID As Long 'Primary key value of the new record.


'Save and edits first
If Me.Dirty Then
Me.Dirty = False
End If

'Make sure there is a record to duplicate.
If Me.NewRecord Then
MsgBox "Select the record to duplicate."
Else
'Duplicate the main record: add to form's clone.
With Me.RecordsetClone
.AddNew
!ControlDataDe = Me.ControlDataDe
!ControlDataA = Me.ControlDataA
'etc for other fields.
.Update

'Save the primary key value, to use as the foreign key for
the related records.
.Bookmark = .LastModified
lngID = !ControlDataID

'Duplicate the related records: append query.
strSql = "INSERT INTO [tblControlSeccao] (ControlDataID,
Seccao) " & _
"SELECT " & lngID & " As NewID, Seccao " & _
"FROM [tblControlSeccao] WHERE ControlDataID = " &
Me.ControlDataID & ";"
DBEngine(0)(0).Execute strSql, dbFailOnError



'Display the new duplicate.
Me.Bookmark = .LastModified
Me.sbfrmControl.Visible = False
Me.sbsbfrmControl.Visible = False
Me.sbsbsbfrmControl.Visible = False
Me.Label17.Visible = False
Me.Label23.Visible = True
Me.ControlDataDe.Locked = False
Me.ControlDataA.Locked = False
Me.ControlDataDe.Value = Null
Me.ControlDataA.Value = Null
End With
End If

Exit_Handler:
Exit Sub

Err_Handler:
MsgBox "Error " & Err.Number & " - " & Err.Description, ,
"Label22_Click"
Resume Exit_Handler

End Sub

Any assistance would be greatly appreciated!

Thank you!

Odeh

.

Quantcast