, , , . , , , :
Private mlngBkmkCounter As Long
Public Sub updfConcatenate(pvarFromPaths As Variant, _
pstrToPath As String)
Dim origPdfDoc As Acrobat.CAcroPDDoc
Dim newPdfDoc As Acrobat.CAcroPDDoc
Dim lngNewPageCount As Long
Dim lngInsertPage As Long
Dim i As Long
Set origPdfDoc = CreateObject("AcroExch.PDDoc")
Set newPdfDoc = CreateObject("AcroExch.PDDoc")
mlngBkmkCounter = 0
'set the first file in the array as the "new"'
If newPdfDoc.Open(pvarFromPaths(LBound(pvarFromPaths))) = True Then
updfInsertBookmark "Test Start", lngInsertPage, , newPdfDoc
mlngBkmkCounter = 1
For i = LBound(pvarFromPaths) + 1 To UBound(pvarFromPaths)
Application.StatusBar = "Merging " & pvarFromPaths(i) & "..."
If origPdfDoc.Open(pvarFromPaths(i)) = True Then
lngInsertPage = newPdfDoc.GetNumPages
newPdfDoc.InsertPages lngInsertPage - 1, origPdfDoc, 0, origPdfDoc.GetNumPages, False
updfInsertBookmark "Test " & i, lngInsertPage, , newPdfDoc
origPdfDoc.Close
mlngBkmkCounter = mlngBkmkCounter + 1
End If
Next i
newPdfDoc.Save PDSaveFull, pstrToPath
End If
ExitHere:
Set origPdfDoc = Nothing
Set newPdfDoc = Nothing
Application.StatusBar = False
Exit Sub
End Sub
-... ,
Public Sub updfInsertBookmark(pstrCaption As String, _
plngPage As Long, _
Optional pstrPath As String, _
Optional pMyPDDoc As Acrobat.CAcroPDDoc, _
Optional plngIndex As Long = -1, _
Optional plngParentIndex As Long = -1)
Dim MyPDDoc As Acrobat.CAcroPDDoc
Dim jso As Object
Dim BMR As Object
Dim arrParents As Variant
Dim bkmChildsParent As Object
Dim bleContinue As Boolean
Dim bleSave As Boolean
Dim lngIndex As Long
If pMyPDDoc Is Nothing Then
Set MyPDDoc = CreateObject("AcroExch.PDDoc")
bleContinue = MyPDDoc.Open(pstrPath)
bleSave = True
Else
Set MyPDDoc = pMyPDDoc
bleContinue = True
End If
If plngIndex > -1 Then
lngIndex = plngIndex
Else
lngIndex = mlngBkmkCounter
End If
If bleContinue = True Then
Set jso = MyPDDoc.GetJSObject
Set BMR = jso.bookmarkRoot
If plngParentIndex > -1 Then
arrParents = jso.bookmarkRoot.Children
Set bkmChildsParent = arrParents(plngParentIndex)
bkmChildsParent.createchild pstrCaption, "this.pageNum= " & plngPage, lngIndex
Else
BMR.createchild pstrCaption, "this.pageNum= " & plngPage, lngIndex
End If
MyPDDoc.SetPageMode 3 '3 — display using bookmarks'
If bleSave = True Then
MyPDDoc.Save PDSaveIncremental, pstrPath
MyPDDoc.Close
End If
End If
ExitHere:
Set jso = Nothing
Set BMR = Nothing
Set arrParents = Nothing
Set bkmChildsParent = Nothing
Set MyPDDoc = Nothing
End Sub
:
Public Sub uTest_pdfConcatenate()
Const cPath As String = "C:\MyPath\"
updfConcatenate Array(cPath & "Test1.pdf", _
cPath & "Test2.pdf", _
cPath & "Test3.pdf"), "C:\Temp\TestOut.pdf"
End Sub