I have the following code to duplicate my invoice (mainform and subform) form. This works well, thanks to Allen Brown.
_____________________________ Code Begin _______________________________
Public Function DuplicateInvoice()
On Error GoTo Err_ErrorHandler
'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.
Dim intAnswer As Integer
Dim rs As Object
'Declare Document constants
Dim dbsInvoice As DAO.Database
Dim rstInvoice As DAO.Recordset
Set dbsInvoice = CurrentDb
Set rstInvoice = dbsInvoice.OpenRecordset("tblFinance", dbOpenDynaset)
PlaySound
'Save any edits first
If Forms!frmMainMenu!SubMenu!MiniMenu.Form.Dirty Then
Forms!frmMainMenu!SubMenu!MiniMenu.Form.Dirty = False
End If
'Make sure there is a record to duplicate.
If Forms!frmMainMenu!SubMenu!MiniMenu.Form.NewRecord Then
MsgBox "Select the record to duplicate.", vbOKOnly + vbInformation, "TestDB"
Else
intAnswer = MsgBox("You have selected Invoice " & Forms!frmMainMenu!SubMenu!MiniMenu!InvoiceNumber & " to be duplicated." & Chr(13) & _
"" & Chr(13) & _
"If you click Yes, the invoice will be duplicated." & Chr(13) & _
"Are you sure you want to duplicate this Invoice?", vbYesNo + vbExclamation, "TestDB")
Select Case intAnswer
Case vbYes:
'Duplicate the main record: add to form's clone.
rstInvoice.AddNew
rstInvoice("ParentID") = Forms!frmMainMenu!SubMenu!MiniMenu!ParentID
rstInvoice("ChildID") = Forms!frmMainMenu!SubMenu!MiniMenu!ChildID
rstInvoice("EmployeeID") = Forms!frmMainMenu!SubMenu!MiniMenu!EmployeeID
rstInvoice("InvoiceNumber") = NewQuoteNumber 'Function to create a new invoice number
rstInvoice("InvoiceStatus") = "Draft Invoice"
rstInvoice("InvoiceType") = "Normal"
rstInvoice("Void") = "No"
rstInvoice("Approved") = "No"
rstInvoice("OrderDate") = Now()
rstInvoice("DueDate") = Forms!frmMainMenu!SubMenu!MiniMenu!DueDate
rstInvoice("PurchaseOrderNumber") = Forms!frmMainMenu!SubMenu!MiniMenu!PurchaseOrderNumber
rstInvoice("ShipDate") = Forms!frmMainMenu!SubMenu!MiniMenu!ShipDate
rstInvoice("FreightCharge") = Forms!frmMainMenu!SubMenu!MiniMenu!FreightCharge
rstInvoice("SalesTaxRate") = Forms!frmMainMenu!SubMenu!MiniMenu!SalesTaxRate
rstInvoice.Update
rstInvoice.Bookmark = rstInvoice.LastModified
lngID = rstInvoice("FinanceID")
'Duplicate the related records: append query.
If Forms!frmMainMenu!SubMenu!MiniMenu!frmFinanceSubform.Form.RecordsetClone.RecordCount > 0 Then
strSQL = "INSERT INTO [tblFinanceDetails] ( FinanceID, ServiceID, Description, Quantity, UnitPrice, Discount ) " & _
"SELECT " & lngID & " As NewID, ServiceID, Description, Quantity, UnitPrice, Discount " & _
"FROM [tblFinanceDetails] WHERE FinanceID = " & Forms!frmMainMenu!SubMenu!MiniMenu!FinanceID & ";"
DBEngine(0)(0).Execute strSQL, dbFailOnError
'Post payment
PostNullInvoicePay (lngID)
'Note the duplication
PostInvoiceNote lngID, "Created by " & funUserName()
'Notify user that the operation was successful
MsgBox "Your invoice duplication was successful.", vbOKOnly + vbInformation, "Nursery Manager"
Else
MsgBox "Main record duplicated, but there were no related records.", vbOKOnly + vbInformation, "Nursery Manager"
End If
'close and clear the recordset from cache
rstInvoice.Close
dbsInvoice.Close
Set rstInvoice = Nothing
Set dbsInvoice = Nothing
'Display the new duplicate.
Forms!frmMainMenu!SubMenu!MiniMenu.Form.Bookmark = rstInvoice.LastModified
Case vbNo:
Exit Function
End Select
End If
Exit Function
Exit_ErrorHandler:
Exit Function
Err_ErrorHandler:
MsgBox err.Description, vbOKOnly + vbInformation, "TestDB"
Resume Exit_ErrorHandler
End Function
________________________________________________End of Code_______________________________________
What I am trying to do now is modify the above code to copy an invoice from tblFinance and all its line items from tblFinanceDetails. All I was able to do was copy the invoice details and not the line details as a new record.
I need this since the function that checks my recurring table needs to be able to pick a FinanceID thas has been set as a recurring invoice and duplicate it to the same table but with some few changes from the recurring table.
Here is what I have been able to come up with:
_______________________________________________ Code Begin ________________________________________
Public Function CreateRecurringInvoice(pptFinanceID As Long, pptInvoiceDate As Date, pptDueDate As Date, _
pptInvoiceStatus As String)
On Error GoTo Err_ErrorHandler
'Purpose: Duplicate the record with unique FinanceID record and related records into the same table with the parameters supplied when the function is called.
Dim strSQL As String 'SQL statement.
Dim strSQA As String 'SQL statement.
Dim strSQG As String 'SQL statement.
Dim lngID As Long 'Primary key value of the new record.
Dim intAnswer As Integer
Dim rs As Object
Dim strOldParent As String
Dim strOldChildID As Long
Dim strOldEmployeeID As Long
Dim strOldPurchaseOrderNumber As String
Dim strOldFreightCharge As Currency
Dim strOldSalesTaxRate As Currency
Dim strOldComment As String
'Declare Document constants
Dim dbsInvoice As DAO.Database
Dim dbsIntelliFees As DAO.Database
Dim rstInvoice As DAO.Recordset
Dim rstFinanceDetails As DAO.Recordset
Dim rstRecurring As DAO.Recordset
Set dbsInvoice = CurrentDb
Set rstInvoice = dbsInvoice.OpenRecordset("tblFinance", dbOpenDynaset)
Set dbsIntelliFees = CurrentDb
strSQA = "SELECT * FROM tblFinance WHERE FinanceID = " & pptFinanceID
Set rstRecurring = dbsIntelliFees.OpenRecordset(strSQA, dbOpenDynaset)
With rstRecurring
strOldParent = !ParentID
strOldChildID = !ChildID
strOldEmployeeID = !EmployeeID
strOldPurchaseOrderNumber = !PurchaseOrderNumber
strOldFreightCharge = !FreightCharge
strOldSalesTaxRate = !SalesTaxRate
strOldComment = !Comment
End With
rstInvoice.AddNew
rstInvoice("ParentID") = strOldParent
rstInvoice("ChildID") = strOldChildID
rstInvoice("Comment") = strOldComment
rstInvoice("EmployeeID") = strOldEmployeeID
rstInvoice("InvoiceNumber") = NewQuoteNumber
rstInvoice("InvoiceStatus") = pptInvoiceStatus
rstInvoice("InvoiceType") = "Recurring"
rstInvoice("Void") = "No"
rstInvoice("Approved") = "No"
rstInvoice("OrderDate") = pptInvoiceDate
rstInvoice("DueDate") = pptDueDate
rstInvoice("PurchaseOrderNumber") = strOldPurchaseOrderNumber
rstInvoice("ShipDate") = pptInvoiceDate
rstInvoice("FreightCharge") = strOldFreightCharge
rstInvoice("SalesTaxRate") = strOldSalesTaxRate
rstInvoice.Update
lngID = rstInvoice("FinanceID")
'Duplicate the related records: append query.
strSQL = "INSERT INTO [tblFianceDetails] ( FinanceID, ServiceID, Description, Quantity, UnitPrice, Discount ) " & _
"SELECT " & lngID & " As NewID, ServiceID, Description, Quantity, UnitPrice, Discount " & _
"FROM [tblFinanceDetails] WHERE FinanceID = " & pptFinanceID & ";"
DBEngine(0)(0).Execute strSQL, dbFailOnError
'Post payment
PostNullInvoicePay (lngID)
'Note the duplication
PostInvoiceNote lngID, "Recurring Invoice auto created at the login session of " & funUserName()
'close and clear the recordset from cache
rstInvoice.Close
dbsInvoice.Close
Set rstInvoice = Nothing
Set dbsInvoice = Nothing
rstRecurring.Close
dbsIntelliFees.Close
Set rstRecurring = Nothing
Set dbsIntelliFees = Nothing
'Requery the MainForm to this new invoice number
Set rs = Forms!frmMainMenu!SubMenu.Form.Recordset.Clone
rs.FindFirst "[FinanceID] = " & Str(Nz(lngID, 0))
If Not rs.EOF Then Forms!frmMainMenu!SubMenu.Form.Bookmark = rs.Bookmark
Forms!frmMainMenu!SubMenu.Form.Requery
Exit_ErrorHandler:
Exit Function
Err_ErrorHandler:
MsgBox err.Description, vbOKOnly + vbInformation, "Nursery Manager"
Resume Exit_ErrorHandler
End Function
____________________________________________________ Code End _________________________________
All I have been able to achieve with this is copy only the invoice details but not the related details in the tblFinanceDetails.
Can anyone be generous enough to look into my code and help out please?
Thanks.
_____________________________ Code Begin _______________________________
Public Function DuplicateInvoice()
On Error GoTo Err_ErrorHandler
'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.
Dim intAnswer As Integer
Dim rs As Object
'Declare Document constants
Dim dbsInvoice As DAO.Database
Dim rstInvoice As DAO.Recordset
Set dbsInvoice = CurrentDb
Set rstInvoice = dbsInvoice.OpenRecordset("tblFinance", dbOpenDynaset)
PlaySound
'Save any edits first
If Forms!frmMainMenu!SubMenu!MiniMenu.Form.Dirty Then
Forms!frmMainMenu!SubMenu!MiniMenu.Form.Dirty = False
End If
'Make sure there is a record to duplicate.
If Forms!frmMainMenu!SubMenu!MiniMenu.Form.NewRecord Then
MsgBox "Select the record to duplicate.", vbOKOnly + vbInformation, "TestDB"
Else
intAnswer = MsgBox("You have selected Invoice " & Forms!frmMainMenu!SubMenu!MiniMenu!InvoiceNumber & " to be duplicated." & Chr(13) & _
"" & Chr(13) & _
"If you click Yes, the invoice will be duplicated." & Chr(13) & _
"Are you sure you want to duplicate this Invoice?", vbYesNo + vbExclamation, "TestDB")
Select Case intAnswer
Case vbYes:
'Duplicate the main record: add to form's clone.
rstInvoice.AddNew
rstInvoice("ParentID") = Forms!frmMainMenu!SubMenu!MiniMenu!ParentID
rstInvoice("ChildID") = Forms!frmMainMenu!SubMenu!MiniMenu!ChildID
rstInvoice("EmployeeID") = Forms!frmMainMenu!SubMenu!MiniMenu!EmployeeID
rstInvoice("InvoiceNumber") = NewQuoteNumber 'Function to create a new invoice number
rstInvoice("InvoiceStatus") = "Draft Invoice"
rstInvoice("InvoiceType") = "Normal"
rstInvoice("Void") = "No"
rstInvoice("Approved") = "No"
rstInvoice("OrderDate") = Now()
rstInvoice("DueDate") = Forms!frmMainMenu!SubMenu!MiniMenu!DueDate
rstInvoice("PurchaseOrderNumber") = Forms!frmMainMenu!SubMenu!MiniMenu!PurchaseOrderNumber
rstInvoice("ShipDate") = Forms!frmMainMenu!SubMenu!MiniMenu!ShipDate
rstInvoice("FreightCharge") = Forms!frmMainMenu!SubMenu!MiniMenu!FreightCharge
rstInvoice("SalesTaxRate") = Forms!frmMainMenu!SubMenu!MiniMenu!SalesTaxRate
rstInvoice.Update
rstInvoice.Bookmark = rstInvoice.LastModified
lngID = rstInvoice("FinanceID")
'Duplicate the related records: append query.
If Forms!frmMainMenu!SubMenu!MiniMenu!frmFinanceSubform.Form.RecordsetClone.RecordCount > 0 Then
strSQL = "INSERT INTO [tblFinanceDetails] ( FinanceID, ServiceID, Description, Quantity, UnitPrice, Discount ) " & _
"SELECT " & lngID & " As NewID, ServiceID, Description, Quantity, UnitPrice, Discount " & _
"FROM [tblFinanceDetails] WHERE FinanceID = " & Forms!frmMainMenu!SubMenu!MiniMenu!FinanceID & ";"
DBEngine(0)(0).Execute strSQL, dbFailOnError
'Post payment
PostNullInvoicePay (lngID)
'Note the duplication
PostInvoiceNote lngID, "Created by " & funUserName()
'Notify user that the operation was successful
MsgBox "Your invoice duplication was successful.", vbOKOnly + vbInformation, "Nursery Manager"
Else
MsgBox "Main record duplicated, but there were no related records.", vbOKOnly + vbInformation, "Nursery Manager"
End If
'close and clear the recordset from cache
rstInvoice.Close
dbsInvoice.Close
Set rstInvoice = Nothing
Set dbsInvoice = Nothing
'Display the new duplicate.
Forms!frmMainMenu!SubMenu!MiniMenu.Form.Bookmark = rstInvoice.LastModified
Case vbNo:
Exit Function
End Select
End If
Exit Function
Exit_ErrorHandler:
Exit Function
Err_ErrorHandler:
MsgBox err.Description, vbOKOnly + vbInformation, "TestDB"
Resume Exit_ErrorHandler
End Function
________________________________________________End of Code_______________________________________
What I am trying to do now is modify the above code to copy an invoice from tblFinance and all its line items from tblFinanceDetails. All I was able to do was copy the invoice details and not the line details as a new record.
I need this since the function that checks my recurring table needs to be able to pick a FinanceID thas has been set as a recurring invoice and duplicate it to the same table but with some few changes from the recurring table.
Here is what I have been able to come up with:
_______________________________________________ Code Begin ________________________________________
Public Function CreateRecurringInvoice(pptFinanceID As Long, pptInvoiceDate As Date, pptDueDate As Date, _
pptInvoiceStatus As String)
On Error GoTo Err_ErrorHandler
'Purpose: Duplicate the record with unique FinanceID record and related records into the same table with the parameters supplied when the function is called.
Dim strSQL As String 'SQL statement.
Dim strSQA As String 'SQL statement.
Dim strSQG As String 'SQL statement.
Dim lngID As Long 'Primary key value of the new record.
Dim intAnswer As Integer
Dim rs As Object
Dim strOldParent As String
Dim strOldChildID As Long
Dim strOldEmployeeID As Long
Dim strOldPurchaseOrderNumber As String
Dim strOldFreightCharge As Currency
Dim strOldSalesTaxRate As Currency
Dim strOldComment As String
'Declare Document constants
Dim dbsInvoice As DAO.Database
Dim dbsIntelliFees As DAO.Database
Dim rstInvoice As DAO.Recordset
Dim rstFinanceDetails As DAO.Recordset
Dim rstRecurring As DAO.Recordset
Set dbsInvoice = CurrentDb
Set rstInvoice = dbsInvoice.OpenRecordset("tblFinance", dbOpenDynaset)
Set dbsIntelliFees = CurrentDb
strSQA = "SELECT * FROM tblFinance WHERE FinanceID = " & pptFinanceID
Set rstRecurring = dbsIntelliFees.OpenRecordset(strSQA, dbOpenDynaset)
With rstRecurring
strOldParent = !ParentID
strOldChildID = !ChildID
strOldEmployeeID = !EmployeeID
strOldPurchaseOrderNumber = !PurchaseOrderNumber
strOldFreightCharge = !FreightCharge
strOldSalesTaxRate = !SalesTaxRate
strOldComment = !Comment
End With
rstInvoice.AddNew
rstInvoice("ParentID") = strOldParent
rstInvoice("ChildID") = strOldChildID
rstInvoice("Comment") = strOldComment
rstInvoice("EmployeeID") = strOldEmployeeID
rstInvoice("InvoiceNumber") = NewQuoteNumber
rstInvoice("InvoiceStatus") = pptInvoiceStatus
rstInvoice("InvoiceType") = "Recurring"
rstInvoice("Void") = "No"
rstInvoice("Approved") = "No"
rstInvoice("OrderDate") = pptInvoiceDate
rstInvoice("DueDate") = pptDueDate
rstInvoice("PurchaseOrderNumber") = strOldPurchaseOrderNumber
rstInvoice("ShipDate") = pptInvoiceDate
rstInvoice("FreightCharge") = strOldFreightCharge
rstInvoice("SalesTaxRate") = strOldSalesTaxRate
rstInvoice.Update
lngID = rstInvoice("FinanceID")
'Duplicate the related records: append query.
strSQL = "INSERT INTO [tblFianceDetails] ( FinanceID, ServiceID, Description, Quantity, UnitPrice, Discount ) " & _
"SELECT " & lngID & " As NewID, ServiceID, Description, Quantity, UnitPrice, Discount " & _
"FROM [tblFinanceDetails] WHERE FinanceID = " & pptFinanceID & ";"
DBEngine(0)(0).Execute strSQL, dbFailOnError
'Post payment
PostNullInvoicePay (lngID)
'Note the duplication
PostInvoiceNote lngID, "Recurring Invoice auto created at the login session of " & funUserName()
'close and clear the recordset from cache
rstInvoice.Close
dbsInvoice.Close
Set rstInvoice = Nothing
Set dbsInvoice = Nothing
rstRecurring.Close
dbsIntelliFees.Close
Set rstRecurring = Nothing
Set dbsIntelliFees = Nothing
'Requery the MainForm to this new invoice number
Set rs = Forms!frmMainMenu!SubMenu.Form.Recordset.Clone
rs.FindFirst "[FinanceID] = " & Str(Nz(lngID, 0))
If Not rs.EOF Then Forms!frmMainMenu!SubMenu.Form.Bookmark = rs.Bookmark
Forms!frmMainMenu!SubMenu.Form.Requery
Exit_ErrorHandler:
Exit Function
Err_ErrorHandler:
MsgBox err.Description, vbOKOnly + vbInformation, "Nursery Manager"
Resume Exit_ErrorHandler
End Function
____________________________________________________ Code End _________________________________
All I have been able to achieve with this is copy only the invoice details but not the related details in the tblFinanceDetails.
Can anyone be generous enough to look into my code and help out please?
Thanks.