Private Function PartDuplicateDocument(bReverse As Boolean)
' This is the event handler for two buttons, Duplicate or Reverse
' if bReverse = 0, this is a duplicate not reversed
' reverse: test the 0. interpreted as false.
' Create a new document entry with only the tagged lines
' The new document is placed in the daybook for editing
Dim db As DAO.Database
Dim rsHeader As DAO.Recordset
Dim rsTLsource As DAO.Recordset
Dim rsTLtarget As DAO.Recordset
'' tried this still doesn't work
'' Dim db As Database
'' Dim rsHeader As Recordset
'' Dim rsTLsource As Recordset
'' Dim rsTLtarget As Recordset
Dim lngNewHeaderID As Long
Dim strOldDocRef As String ' eg "PINV1234567"
Dim strNewDocRef As String ' eg "PINV1234959"
Dim strSQL As String
Dim strSourceText As String ' eg "PINV1234567 Part Duplicated"
Dim intResponse As Integer
Dim intKeepSourceTags As Integer
Dim intLineNumber As Integer ' line number within the document
Dim curNewNetValue As Currency
Dim curNewNetTotal As Currency
Dim curNewVatValue As Currency
Dim curNewVatTotal As Currency
Dim lngLinesTagged As Integer ' number of lines that are tagged
Dim lngCurrentRec As Long ' the existing document that we're editing
Set db = CurrentDb
strSQL = "Select * from tblTransLines where tlTransHeaderFK = " & Me!TransHeaderID
strSQL = strSQL & " Order by tlLineNumber"
lngCurrentRec = Me!TransHeaderID ' the document we're editing
' First we need to see if any lines are tagged. We don't want to save an empty document
lngLinesTagged = fTaggedLineCount(lngCurrentRec)
' don't perform this routine if the document header isn't valid
' we get an error at the end once Access has tried to auto-save
If lngLinesTagged > 0 Then
If fFormIsValid Then
'--------------------------------------------------------------------------------
' Preliminary Confirmation to Proceed with Duplication or Reversal
'--------------------------------------------------------------------------------
Select Case bytPurchCurrentTab
Case 0 ' templates
If Not bReverse Then
intResponse = MsgBox _
("Create new template with " & lngLinesTagged & " tagged line(s) ?", _
vbYesNo, "Duplicate Template Lines")
Else
intResponse = MsgBox _
("Create new template with " & lngLinesTagged & " tagged line(s) reversed ?", _
vbYesNo, "Reverse Template Lines")
End If
Case 3 To 4 ' documents daybook or posted can be duplicated or reversed
If Not bReverse Then
intResponse = MsgBox _
("Create new document with " & lngLinesTagged & " tagged line(s) ?", _
vbYesNo, "Duplicate document Lines")
Else
intResponse = MsgBox _
("Create new document with " & lngLinesTagged & " tagged line(s) reversed ?", _
vbYesNo, "Reverse document Lines")
End If
Case Else
End Select
If intResponse = vbYes Then
'--------------------------------------------------------------------------------
' Add Transaction Header for the Duplicated or Reversed document
'--------------------------------------------------------------------------------
' We can optionally keep the tags in the existing document header instead of clearing them
intKeepSourceTags = MsgBox("Retain tags in the existing document ?", vbYesNo, "Retain tags")
Set rsHeader = db.OpenRecordset("tblTransHeaders", dbOpenDynaset)
'MsgBox ("1")
With rsHeader
rsHeader.AddNew ' prepare a new document header
Select Case bytPurchCurrentTab
Case 0
strNewDocRef = fNextDocRef("PTEM") ' fetch a new template ref
Case 3 To 4
strNewDocRef = fNextDocRef("PINV") ' fetch a new invoice ref
Case Else
End Select
strOldDocRef = Me.thDocReference ' we save this to add narrative
strSourceText = strOldDocRef ' "Purch1234567"
If bReverse Then
strSourceText = strSourceText & " Reversed"
Else
strSourceText = strSourceText & " Duplicated"
End If
'!TransHeaderID = ' Access deals with this
!thCustSuppFk = Me.thCustSuppFk ' same customer
!thDelAddrFK = Me.thDelAddrFK ' same delivery address
'!thDocType =
!thDocReference = strNewDocRef ' the new document ref eg. PINV1234959
!thDate = Date ' always today's date
'!thDueDate =
!thPeriod = Me.thPeriod
!thYear = Me.thYear
!thText1 = Me.thText1
!thText2 = Me.thText2
!thPostingBatchNo = 0 ' goes in the daybook for editing
!thYourOrderRef = strSourceText ' we use this field to store source details
'!thAlternativeRef =
!thText1 = ""
!thText2 = ""
!thShippingMethod = ""
'!thNetValue_summed = ' see below
'!thCostValue_summed =
thTaggedLines_summed = 0 ' all turned off for new record
'!thVatValue_summed = ' see below
!thSettDisc_summed = 0
!thAllocatedValue_summed = 0
!thWeight_summed = 0
'!thStatus =
!thAuth2Post = 0
!thAutoReverse = 0
!thAuth2Pay = 0
!thReconciled = 0
!thTagged = 0
!thPrinted = 0
!thDateAdded = Now()
'!thUserAdded =
'thDateEdited =
'thUserEdited =
MsgBox ("About to .update")
rsHeader.Update ' write the new document header FAILS
MsgBox ("About to .bookmark")
.Bookmark = rsHeader.LastModified ' This line IS required not sure why !!
' we should now have the new AutoNumber key that we need
lngNewHeaderID = rsHeader!TransHeaderID ' the new auto number that we need
'--------------------------------------------------------------------------------
' Copy or Reverse Transaction Lines for the Duplicated or Reversed document
'--------------------------------------------------------------------------------
