Re: Duplicate Data in Form, its Subform and SubSubForm

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
.