Private Sub DupeRecord_Click()
Dim produnqid As Long, res
Dim db As Database, rst As Recordset, msgboxvar
Dim strSQL As String
Set db = CurrentDb()
res = MsgBox("Do you want to duplicate all details for this product?", vbYesNo + vbQuestion, "Duplicate Product Details")
If res = 6 Then 'if Yes
DoCmd.Echo False
'DoCmd.RunCommand acCmdSaveRecord
Set db = CurrentDb()
' turn warnings off:
DoCmd.SetWarnings False
strSQL = "INSERT INTO tblProducts ([Company Unique ID], [PRODUCT CODE],Description," & _
"[LPCB Ref No] , [LPCB Staff ID], [Test Status ID], Listed, Bases, [Flag Date], Notes, [Test Fees]," & _
"[APPLICATION FEES], [Expiration Date], DepartmentId, AgencyId, CROSSLISTING, Base, Business_TypeID," & _
"DIST_UNIQUE_ID, DIST_LPCB_REF_NO, EC_CERTNO, DOCREGISSUENO, EMC_TESTED,RB_LISTED, EC_APPROVED, LPCB_APPR," & _
"DCD_CERT_YN, SOFTWARE_VER, SOFTWARE_YN, CORE_PROD_CODE, MED_CERTNUM, MED_APPROVED, PART_13_YN, LPCB_CERT_NUM," & _
"MODIFIED_DATE, PROJSTATUS)" & _
"SELECT [Company Unique ID], [PRODUCT CODE], Description, [LPCB Ref No] , [LPCB Staff ID], [Test Status ID], " & _
"Listed, Bases, [Flag Date], Notes, [Test Fees], [APPLICATION FEES], [Expiration Date], DepartmentId, " & _
"AgencyId, CROSSLISTING, Base, Business_TypeID, DIST_UNIQUE_ID, DIST_LPCB_REF_NO, EC_CERTNO, DOCREGISSUENO, " & _
"EMC_TESTED, RB_LISTED, EC_APPROVED, LPCB_APPR, DCD_CERT_YN, SOFTWARE_VER, SOFTWARE_YN, CORE_PROD_CODE," & _
"MED_CERTNUM, MED_APPROVED, PART_13_YN, LPCB_CERT_NUM, MODIFIED_DATE,PROJSTATUS" & _
"FROM tblProducts " & _
"WHERE (((tblProducts.[UNIQUE ID])=[Forms]![frmProducts]![Unique ID]));"
Debug.Print strSQL
DoCmd.RunSQL strSQL
Me.Refresh
Set rst = db.OpenRecordset("Select [UNIQUE ID] from tblProducts Order by [UNIQUE ID]", dbOpenDynaset, dbSeeChanges)
With rst
.MoveLast
Me!produnqid = ![Unique ID]
End With
strSQL = "INSERT INTO tblProductRegister ([COMPANY PRODUCT UNIQUE ID], REFERENCE, TITLE, " & _
"[FREE 1], [FREE 2], [FREE 3], [FREE 4], [FREE 5], [FREE 6], [FREE 7], REGINDEX " & _
"SELECT [COMPANY PRODUCT UNIQUE ID], REFERENCE, TITLE, " & _
"[FREE 1], [FREE 2], [FREE 3], [FREE 4], [FREE 5], [FREE 6], [FREE 7], REGINDEX" & _
"FROM tblProductRegister " & _
"WHERE (((tblProductRegister.[COMPANY PRODUCT UNIQUE ID])=[Forms]![frmProducts]![Unique ID])) " & _
"ORDER BY tblProductRegister.[COMPANY PRODUCT UNIQUE ID], tblProductRegister.REGINDEX;"
Debug.Print strSQL
DoCmd.RunSQL strSQL
Me.Refresh
strSQL = "INSERT INTO tblProductTestProgress ([COMPANY PRODUCT UNIQUE ID], [UNIQUE ID],[PROJECT NO]," & _
"TARGET_DATE, TEST_DATE, [TEST STATUS], [TEST REPORT], [REASON ID], " & _
"NOTES, APPRV_LIMS, TEST_STAFF_ID " & _
"SELECT [COMPANY PRODUCT UNIQUE ID], [UNIQUE ID],[PROJECT NO], TARGET_DATE, TEST_DATE, [TEST STATUS]," & _
"[TEST REPORT], [REASON ID], NOTES, APPRV_LIMS, TEST_STAFF_ID" & _
"FROM tblProductTestProgress " & _
"WHERE (((tblProductTestProgress.[COMPANY PRODUCT UNIQUE ID])=[Forms]![frmProducts]![Unique ID]))" & _
"ORDER BY tblProductTestProgress.TARGET_DATE;"
Debug.Print strSQL
DoCmd.RunSQL strSQL
rst.Close
produnqid = Me![produnqid]
' Open form with new details
' Set rst = dbs.OpenRecordset("tblProductMatch", 2)
' rst.AddNew
' rst![Unique ID] = produnqid
' rst.Update
' rst.Close
' DoCmd.Close
retryopen:
'DoCmd.OpenForm "frmProducts", , , "[Unique ID] = " & produnqid
DoCmd.OpenForm "frmProducts", , , "tblProducts.[Unique ID] = " & produnqid
If IsNull(Forms!frmProducts.[Unique ID]) Then
DoCmd.Close acForm, "frmProducts", acSavePrompt
GoTo retryopen
End If
' turn warnings back on:
DoCmd.SetWarnings True
DoCmd.Echo True
msgboxvar = MsgBox("The product has been duplicated", vbOK)
End If
End Sub