Private Sub Command3260_Click()
On Error GoTo Err_Handler
'Purpose: Duplicate the main form record and related records in the subform.
Dim strSQL As String 'SQL statement.
Dim strSQL2 As String
Dim strSQL3 As String
Dim strSQL4 As String
Dim strSQL5 As String
Dim lngID As Long 'Primary key value of the new record.
'Save any 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
!ContextID = Me.ContextID
![Material Type] = Me.[Material Type]
![Ware Type] = Me.[Ware Type]
![Ware Certainty] = Me.Ware_Certainty
![Ware Sub-Type] = Me.Ware_Sub_Type
![Shape General Type] = Me.[Shape General Type]
![Shape Specific Type] = Me.[Shape Specific Type]
![Shape Certainty] = Me.Shape_Certainty
![Preservation State] = Me.[Preservation State]
![Preservation Quality] = Me.[Preservation Quality]
![Forming Notes] = Me.Forming_Notes
![Finishing Notes] = Me.Finishing_Notes
![Firing Conditions] = Me.[Firing Conditions]
![Fabric Visible] = Me.Fabric_Visible
![Fabric Type] = Me.[Fabric Type]
![Fabric Texture] = Me.[Fabric Texture]
![Fabric Hardness] = Me.[Fabric Hardness]
![Fabric Fracture] = Me.[Fabric Fracture]
![Fabric Core] = Me.[Fabric Core]
![Fabric Core Colour] = Me.[Fabric Core Colour]
![Notes] = Me.Notes
'etc for other fields.
.Update
'Save the primary key value, to use as the foreign key for the related records.
.Bookmark = .LastModified
lngID = !SherdID
'Duplicate the related records: append query.
If Me.DiagnosticParts_subform.Form.RecordsetClone.RecordCount > 0 Or _
Me.FunctionTypes_subform.Form.RecordsetClone.RecordCount > 0 Or _
Me.FormingTechniques_subform.Form.RecordsetClone.RecordCount > 0 Or _
Me.FinishingTechniques_subform.Form.RecordsetClone.RecordCount > 0 Or _
Me.DiagnosticsSurfacesubform.Form.RecordsetClone.RecordCount > 0 Then
If Me.DiagnosticParts_subform.Form.RecordsetClone.RecordCount > 0 Then
strSQL = "INSERT INTO [DiagnosticParts] (ID, SherdID, Body, Rim, Neck, Shoulder, Base, HandleLug, Spout ) " & _
"SELECT " & DMax("ID", "DiagnosticParts") + 1 & " As NewID, " & lngID & " As NewSherdID, Body, Rim, Neck, Shoulder, Base, HandleLug, Spout " & _
"FROM [DiagnosticParts] WHERE SherdID = " & Me.SherdID & ";"
DBEngine(0)(0).Execute strSQL, dbFailOnError
End If
If Me.FunctionTypes_subform.Form.RecordsetClone.RecordCount > 0 Then
strSQL2 = "INSERT INTO [FunctionTypes] (ID, SherdID, [Liquid Storage], [Dry Storage], [Food PreparationService], Cooking, RitualCeremonial) " & _
"SELECT " & DMax("ID", "FunctionTypes") + 1 & " As NewID, " & lngID & " As NewSherdID, [Liquid Storage], [Dry Storage], [Food PreparationService], Cooking, RitualCeremonial " & _
"FROM [FunctionTypes] where SherdID = " & Me.SherdID & ";"
DBEngine(0)(0).Execute strSQL2, dbFailOnError
End If
If Me.FormingTechniques_subform.Form.RecordsetClone.RecordCount > 0 Then
strSQL3 = "INSERT INTO [FormingTechniques] (ID, SherdID, PinchingDrawing, [CoilingSlab Building], MoldingPressing, Throwing, Unknown) " & _
"SELECT " & DMax("ID", "FormingTechniques") + 1 & " As NewID, " & lngID & " As NewSherdID, PinchingDrawing, [CoilingSlab Building], MoldingPressing, Throwing, Unknown " & _
"FROM [FormingTechniques] WHERE SherdID = " & Me.SherdID & ";"
DBEngine(0)(0).Execute strSQL3, dbFailOnError
End If
If Me.FinishingTechniques_subform.Form.RecordsetClone.RecordCount > 0 Then
strSQL4 = "INSERT INTO [FinishingTechniques] (ID, SherdID, BeatingPaddling, Scraping, TrimmingFettling, Smoothing, BurnishingPolishing, Roughening, PatterningTexturing, Unknown) " & _
"SELECT " & DMax("ID", "FinishingTechniques") + 1 & " As NewID, " & lngID & " As NewSherdID, BeatingPaddling, Scraping, TrimmingFettling, Smoothing, BurnishingPolishing, Roughening, PatterningTexturing, Unknown " & _
"FROM [FinishingTechniques] WHERE SherdID = " & Me.SherdID & ";"
DBEngine(0)(0).Execute strSQL4, dbFailOnError
End If
If Me.DiagnosticsSurfacesubform.Form.RecordsetClone.RecordCount > 0 Then
strSQL5 = "INSERT INTO [DiagnosticsSurface] (ID, SherdID, [Incised Motifs], [Relief Motifs], [Impressed Motifs], [Painted Motifs], [Burnished Motifs], [Slipping Inside], [Slipping Outside], [Slipping Preservation Inside]," _
& "[Slipping Preservation Outside], [Slipping Inside Type], [Slipping Outside Type], [Painting Inside], [Painting Outside], [Painting Preservation Inside], [Painting Preservation Outside], [Painting Thickness], [Incising Inside]," _
& "[Incising Outside], [Incising Preservation Inside], [Incising Preservation Outside], [Incising Type], [Burnishing Inside], [Burnishing Outside], [Burnishing Preservation Inside], [Burnishing Preservation Outside], [Burnishing Type]," _
& "[Combing Inside], [Combing Outside], [Combing Preservation Inside], [Combing Preservation Outside], [ImpressingStamping Inside], [ImpressingStamping Outside], [ImpressingStamping Preservation Inside], [ImpressingStamping Preservation Outside]," _
& "[AppliqueRelief Inside], [AppliqueRelief Outside], [AppliqueRelief Preservation Inside], [AppliqueRelief Preservation Outside], [Lustre Inside], [Lustre Outside])" & _
"SELECT " & DMax("ID", "DiagnosticsSurface") + 1 & " As NewID, " & lngID & " As NewSherdID, [Incised Motifs], [Relief Motifs], [Impressed Motifs], [Painted Motifs], [Burnished Motifs], [Slipping Inside], [Slipping Outside], [Slipping Preservation Inside]," _
& "[Slipping Preservation Outside], [Slipping Inside Type], [Slipping Outside Type], [Painting Inside], [Painting Outside], [Painting Preservation Inside], [Painting Preservation Outside], [Painting Thickness], [Incising Inside]," _
& "[Incising Outside], [Incising Preservation Inside], [Incising Preservation Outside], [Incising Type], [Burnishing Inside], [Burnishing Outside], [Burnishing Preservation Inside], [Burnishing Preservation Outside], [Burnishing Type]," _
& "[Combing Inside], [Combing Outside], [Combing Preservation Inside], [Combing Preservation Outside], [ImpressingStamping Inside], [ImpressingStamping Outside], [ImpressingStamping Preservation Inside], [ImpressingStamping Preservation Outside]," _
& "[AppliqueRelief Inside], [AppliqueRelief Outside], [AppliqueRelief Preservation Inside], [AppliqueRelief Preservation Outside], [Lustre Inside], [Lustre Outside]" & _
"FROM [DiagnosticsSurface] WHERE SherdID = " & Me.SherdID & ";"
DBEngine(0)(0).Execute strSQL5, dbFailOnError
End If
Else
MsgBox "Main record duplicated, but there were no related records."
End If
'Display the new duplicate.
Me.Bookmark = .LastModified
End With
End If
Exit_Handler:
Exit Sub
Err_Handler:
MsgBox "Error " & Err.Number & " - " & Err.Description, , "cmdDupe_Click"
Resume Exit_Handler
End Sub
