VBA Code:
Dim acroOrigPdfDoc As Object 'Acrobat.CAcroPDDoc
Dim acroNewPdfDoc As Object 'Acrobat.CAcroPDDoc
Dim varOrigTotalPages As Long
Dim varNewTotalPages As Long
Dim strReportPathName As String
Dim strDoc2Insert As String
Dim i As Integer
Dim varsplit As Variant
Dim varSplit2 As Variant
Dim strMergeInputFile As String
On Error GoTo Errors
varsplit = Split(strFInalOutputDoc, "|", , vbTextCompare)
strMergeInputFile = varsplit(0)
strReportPathName = strPath
varsplit = Split(strMergeNames(0), "|", , vbTextCompare)
Set acroOrigPdfDoc = CreateObject("AcroExch.PDDoc")
Set acroNewPdfDoc = CreateObject("AcroExch.PDDoc")
'Open the first file. That is what will be appended to
' If acroOrigPdfDoc.Open(varSplit(0)) Then
If acroOrigPdfDoc.Open(strMergeInputFile) Then
For i = 0 To UBound(strMergeNames)
varsplit = Split(strMergeNames(i), "|", , vbTextCompare)
varOrigTotalPages = acroOrigPdfDoc.GetNumPages
If acroNewPdfDoc.Open(varsplit(0)) Then
'Get total # of pages to insert
varNewTotalPages = acroNewPdfDoc.GetNumPages
'Insert pages into original pdf
' objCAcroPDDocDestination.InsertPages objCAcroPDDocDestination.GetNumPages - 1, objCAcroPDDocSource, 1, objCAcroPDDocSource.GetNumPages, 0
acroOrigPdfDoc.InsertPages varOrigTotalPages - 1, acroNewPdfDoc, 0, _
varNewTotalPages, False
'Save doc
' acroOrigPdfDoc.Save PDSaveIncremental, strMergeInputFile 'path doesn't matter, will save to original doc
acroOrigPdfDoc.Save PDSaveCopy, strMergeInputFile
acroNewPdfDoc.Close
Else
MsgBox "Failed to open doc "
End If
Next i
acroOrigPdfDoc.Save PDSaveCopy, strFInalOutputDoc
acroNewPdfDoc.Close
' acroOrigPdfDoc.Close
End If
' MsgBox "Pages added to " & path3
MergeThePDFs = True
'Close docs
If Dir(strPath) <> "" Then
Kill strPath
End If
Set acroOrigPdfDoc = Nothing
Set acroNewPdfDoc = Nothing
' rename the report cover file to the actual file name we want
Name strMergeInputFile As strPath
' delete individual files if the checkbox was checked on the form
If blnKillIndFiles Then
For i = 0 To UBound(strMergeNames)
varsplit = Split(strMergeNames(i), "|", , vbTextCompare)
Kill varsplit(0)
Next i
End If
ExitHere:
Exit Function
Errors:
MergeThePDFs = False
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure MergeThePDFs of Module basAcrobat2", , CurrentDb.Properties("AppTitle")
Resume ExitHere
Resume
End Function
