Duplicate Data in Form, its Subform and SubSubForm

  • Thread starter Thread starter Odeh Naber
  • Start date Start date
O

Odeh Naber

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
 
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 said:
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
Click to expand...
 
Hello Steve!

Thank you for the help!

I have introduced the code into my database (as it appears below) but
after clicking on the button on my form, only the first record gets
duplicated, and then the following error appears:

Run time error 3201:

You cannot add or change a record because a related record is required
in table 'tblControlData'.

Scroll down to see where the error appears.

Thank you! Odeh


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 'tblControlArtigo

Dim IngT1PK As Long ' current PK table1
Dim IngT2PK As Long ' current PK table2

Dim IngT1NewFK As Long ' new FK table1
Dim IngT2NewFK As Long ' new FK table2

Dim strSql As String 'SQL statement.
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 'tblControlArtigo


'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
IngT1PK = Me.ControlDataID

With Me.RecordsetClone
.AddNew
!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

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

'Select the records to duplicate
strSql_S = " SELECT SeccaoID, Seccao"
strSql_S = strSql_S & " FROM [tblControlSeccao]"
strSql_S = strSql_S & " WHERE ControlDataID = " & IngT1PK &
";"
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
IngT2PK = rstT2!SeccaoID

'add new record
With rstT2A
.AddNew
!ControlDataID = IngT1NewFK
!Seccao = Nz(rstT2!Seccao, "")
'etc for other fields.
.Update
<---------- The error appears at this update line.

intRC_CS = intRC_CS + 1

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

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

strSql_A = "SELECT ArtigoID, Artigo, PrecoCIVA,
QtdFinalActual"
strSql_A = strSql_A & " FROM [tblControlArtigo]"
strSql_A = strSql_A & " WHERE SeccaoID = " & IngT2PK &
";"

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
strSql = "INSERT INTO tblControlArtigo
(Artigo, PrecoCIVA, QtdInicialActual"
strSql = strSql & ", SeccaoID"
' strSQL = strSQL & ", Field1, Field2, Field3,
Field4"
strSql = strSql & ")"
strSql = strSql & " VALUES("" & Nz(rstT3!
Artigo, "")& "", " & Nz(rstT3!PrecoCIVA, 0)
strSql = strSql & ", " & IngT2NewFK

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 tblControlArtigo"
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
 
Hello Steve!

Thank you for the help!

I have introduced the code into my database (as it appears below) but
after clicking on the button on my form, only the record from the
first table gets
duplicated, and the first record from the second table gets
duplicate. Then I receive the following error appears:

Run time error 3346:

Number of query values and destination fields are not the same.

Scroll down to see where the error appears.

Thank you! Odeh


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 'tblControlArtigo


Dim IngT1PK As Long ' current PK table1
Dim IngT2PK As Long ' current PK table2


Dim IngT1NewFK As Long ' new FK table1
Dim IngT2NewFK As Long ' new FK table2


Dim strSql As String 'SQL statement.
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 'tblControlArtigo


'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
IngT1PK = Me.ControlDataID


With Me.RecordsetClone
.AddNew
!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


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


'Select the records to duplicate
strSql_S = " SELECT SeccaoID, Seccao"
strSql_S = strSql_S & " FROM [tblControlSeccao]"
strSql_S = strSql_S & " WHERE ControlDataID = " & IngT1PK &
";"
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
IngT2PK = rstT2!SeccaoID


'add new record
With rstT2A
.AddNew
!ControlDataID = IngT1NewFK
!Seccao = Nz(rstT2!Seccao, "")
'etc for other fields.
.Update


intRC_CS = intRC_CS + 1


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


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


strSql_A = "SELECT ArtigoID, Artigo, PrecoCIVA,
QtdFinalActual"
strSql_A = strSql_A & " FROM [tblControlArtigo]"
strSql_A = strSql_A & " WHERE SeccaoID = " & IngT2PK
&
";"


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
strSql = "INSERT INTO tblControlArtigo
(Artigo, PrecoCIVA, QtdInicialActual"
strSql = strSql & ", SeccaoID"
' strSQL = strSQL & ", Field1, Field2,
Field3,
Field4"
strSql = strSql & ")"
strSql = strSql & " VALUES("" & Nz(rstT3!
Artigo, "")& "", " & Nz(rstT3!PrecoCIVA, 0)
strSql = strSql & ", " & IngT2NewFK


strSql = strSql & ");"


'insert record
db.Execute strSql, dbFailOnError <---------- The
error appears at this Execute strsql line.



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 tblControlArtigo"
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
 
Hello Steve!

Thank you very much for the help!

I have changed the code in my database to the one you provided - but
the closest I was able to get to my objective was by changing the
INSERT INTO syntax for table 3 into AddNew/Update.

The code I am using is below - and when I click on the button on the
form, it only duplicates the first record of each table - and then
gives me the following error message:

Run time error 3078:
The Microsoft Office Access database engine cannot find the input
table or query. Make sure it exists and that the name is spelled
correctly.

This appears towards the end of the code - at the following line:

db.Execute strSql, dbFailOnError

Any advice?

Thank you! Odeh

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 'tblControlArtigo
Dim rstT3A As DAO.Recordset 'tblControlArtigo

Dim IngT1PK As Long ' current PK table1
Dim IngT2PK As Long ' current PK table2
Dim IngT3PK As Long ' current PK table3

Dim IngT1NewFK As Long ' new FK table1
Dim IngT2NewFK As Long ' new FK table2
Dim IngT3NewFK As Long ' new FK table3

Dim strSql As String 'SQL statement.
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 'tblControlArtigo


'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
IngT1PK = Me.ControlDataID

With Me.RecordsetClone
.AddNew
!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
IngT1NewFK = !ControlDataID
End With


'Duplicate the related records in tblControlSeccao 2nd table

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

'Select the records to duplicate
strSql_S = " SELECT SeccaoID, Seccao"
strSql_S = strSql_S & " FROM [tblControlSeccao]"
strSql_S = strSql_S & " WHERE ControlDataID = " & IngT1PK &
";"
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
IngT2PK = rstT2!SeccaoID

'add new record
With rstT2A
.AddNew
!ControlDataID = IngT1NewFK
!Seccao = Nz(rstT2!Seccao, "")
'etc for other fields.
.Update

intRC_CS = intRC_CS + 1

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

'Duplicate the related records in tblControlArtigo 3nd
table

'Select all records in tblControlArtigo
strSql_A = " SELECT ArtigoID, Artigo, PrecoCIVA,
SeccaoID"
strSql_A = strSql_A & " FROM [tblControlArtigo];"
Set rstT3A = db.OpenRecordset(strSql_A)


'Duplicate the related records in tblControlArtigo
(3rd table)
strSql_A = "SELECT ArtigoID, Artigo, PrecoCIVA"
strSql_A = strSql_A & " FROM [tblControlArtigo]"
strSql_A = strSql_A & " WHERE SeccaoID = " & IngT2PK &
";"
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
'save PK
IngT3PK = rstT3!ArtigoID

'add new record
With rstT3A
.AddNew
!SeccaoID = IngT2NewFK
!Artigo = Nz(rstT3!Artigo, "")
!PrecoCIVA = Nz(rstT3!PrecoCIVA, "")
'etc for other fields.
.Update

intRC_CA = intRC_CA + 1

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

'insert record
db.Execute strSql, dbFailOnError

intRC_CA = intRC_CA + 1

rstT3.MoveNext
Loop
rstT3.Close
rstT3A.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 tblControlArtigo"
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 rstT3A = 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
 
Hello Steve!

Your suggestion worked perfectly!

Thank you very much for your help! I really appreciate it!

Best regards, Odeh
 
Dears
Can anybody explain this part to me from above code
i have same case

'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

i want understand it to do it in my database

thanks in advance
 
Back
Top