Duplicate Record and related records (1 Viewer)

mtn

Registered User.
Local time
Today, 21:42
Joined
Jun 8, 2009
Messages
54
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.
 

mtn

Registered User.
Local time
Today, 21:42
Joined
Jun 8, 2009
Messages
54
I got it working with just this line of code:

rstInvoice.Bookmark = rstInvoice.LastModified

The append query needs that to copy the line details from the tblFinanceDetails.
 

Users who are viewing this thread

Top Bottom