How can I append specific pages from one pdf to another pdf? - vba

Question

Currently I have code which combines pdfs together.
It takes all pages from each file I specify in Column A3:A5 and appends to A2.
Lets say all my pdfs have 5 pages each. However what If I want to only take the first 3 A3, and full 5 pages of A4, and 1 page A5?
Also I don't need to specify in between pages, ie 2 , 4 and 5 of A3.
It will always be in order, ie 1-3 or 1-5 or 1-2.
I have a counter that gets the number of pages already
Dim i As Long, pgnumber As Range
For Each pgnumber In Range("A2:A100")
If Not IsEmpty(pgnumber) Then
i = i + 1
AcroDoc.Open pgnumber
PageNum = AcroDoc.GetNumPages
Cells(pgnumber.Row, 4) = PageNum
End If
AcroDoc.Close
Next pgnumber
full code:
Sub main3()
Set app = CreateObject("Acroexch.app")
Dim FilePaths As Collection
Set FilePaths = New Collection
Dim AcroDoc As Object
Set AcroDoc = New AcroPDDoc
'Counts # of pages in each pdf, loads to column D.
Dim i As Long, pgnumber As Range
For Each pgnumber In Range("A2:A100")
If Not IsEmpty(pgnumber) Then
i = i + 1
AcroDoc.Open pgnumber
PageNum = AcroDoc.GetNumPages
Cells(pgnumber.Row, 4) = PageNum
End If
AcroDoc.Close
Next pgnumber
'Append to this file, ideally will be a front page to append to, commented out for now.
'FilePaths.Add "\path\name\here"
'Active or not feature in Column B, Specify Yes to include in combination, no to exclude
Dim cell As Range
For Each cell In Range("A2:A100")
If cell.Offset(0, 1).Value2 <> "No" Then FilePaths.Add cell.Value2
Next cell
'Combine files which are listed in Column A.
Set primaryDoc = CreateObject("AcroExch.PDDoc")
OK = primaryDoc.Open(FilePaths(1))
Debug.Print "PRIMARY DOC OPENED & PDDOC SET: " & OK
For colIndex = 2 To FilePaths.Count
numPages = primaryDoc.GetNumPages() - 1
Set sourceDoc = CreateObject("AcroExch.PDDoc")
OK = sourceDoc.Open(FilePaths(colIndex))
Debug.Print "(" & colIndex & ") SOURCE DOC OPENED & PDDOC SET: " & OK
numberOfPagesToInsert = sourceDoc.GetNumPages
OK = primaryDoc.InsertPages(numPages, sourceDoc, 0, numberOfPagesToInsert, False)
Debug.Print "(" & colIndex & ") PAGES INSERTED SUCCESSFULLY: " & OK
Set sourceDoc = Nothing
Next colIndex
OK = primaryDoc.Save(PDSaveFull, FilePaths(1))
Debug.Print "PRIMARYDOC SAVED PROPERLY: " & OK
Set primaryDoc = Nothing
app.Exit
Set app = Nothing
MsgBox "DONE"
End Sub
Any help on how to achieve this would be appreciated.
Tried the below code, but it doesn't have any effect:
'attempt to do start and end page in col E and F.
startPage = Range("E" & colIndex)
endPage = Range("F" & colIndex)
OK = sourceDoc.DeletePages(1, startPage - 1)
OK = sourceDoc.DeletePages(endPage - startPage + 2, sourceDoc.GetNumPages)

Answer 1

There is a More Nearly Complete Answer Below
See my comment on your question. If that is accurate, this may fix the problem:
Add:
Dim FileRows As Collection
Set FileRows = New Collection
Change
If cell.Offset(0, 1).Value2 <> "No" Then FilePaths.Add cell.Value2
To:
If cell.Offset(0, 1).Value2 <> "No" Then
FilePaths.Add cell.Value2
FileRows.Add cell.Row
Endif
Change:
startPage = Range("E" & colIndex)
endPage = Range("F" & colIndex)
To:
startPage = Range("E" & FileRows(colIndex))
endPage = Range("F" & FileRows(colIndex))
More Nearly Complete Answer
Okay, I know I shouldn't do this, but here we go. I have revised your code to work the way I think it should work. It is not a complete revision, because the whole thing could be doing in one pass and the Collection objects could be eliminated. There may be bugs in the following code, because I don't have the Adobe Acrobat SDK. But, I think it gets you closer than you were and it puts everything in place. You should be able to do any debugging from here:
Sub CompileDocuments()
Dim acroExchangeApp as Object ' Needed because?
Dim filePaths As Collection ' Paths for PDFs to append
Dim fileRows As Collection ' Row numbers PDFs to append
Dim fileIndex as Long ' For walking through the collections
Dim acroDoc As AcroPDDoc ' Manages imported PDFs
Dim sourceDoc as Object ' Manages imported PDFs (Same as above?)
Dim primaryDoc As Object ' Everything gets appended to this
Dim importPath As Range ' Cell containing a PDF to append
Dim pageCount As Long ' Total pages in an appendable PDF
Dim insertPoint as Long ' PDFs will be appended after this page in the primary Doc
Dim startPage as Long ' First desired page of appended PDF
Dim endPage as Long ' Last desired page of appended PDF
' Initialize
Set filePaths = New Collection
Set fileRows = New Collection
Set acroDoc = New AcroPDDoc
Set acroExchangeApp = CreateObject("Acroexch.app")
Set primaryDoc = CreateObject("AcroExch.PDDoc")
' Pass through rows setting page numbers and capturing paths
For Each importPath In Range("A2:A100")
' Put the page count of each PDF document in column D
If Not IsEmpty(importPath) Then
acroDoc.Open importPath
pageCount = acroDoc.GetNumPages
importPath.OffSet(0,3) = pageCount
acroDoc.Close
End If
Set acroDoc = Nothing
' Remember which documents to append and the row on which they appear
' Skipping any rows with "No" in column B
If importPath.Offset(0, 1).Value2 <> "No" Then
filePaths.Add importPath.Value2
fileRows.Add importPath.Row
End If
Next importPath
' Combine all file listed in Column A.
' Start by opening the file in A2.
OK = primaryDoc.Open(filePaths(1))
Debug.Print "PRIMARY DOC OPENED & PDDOC SET: " & OK
' Loop through the remaining files, appending pages to A2
' Note that columns E and F define the desired pages to extract from
' the appended document.
For fileIndex = 2 To filePaths.Count
' Pages will be added after this insert point
insertPoint = primaryDoc.GetNumPages() - 1
' Open the source document
Set sourceDoc = CreateObject("AcroExch.PDDoc")
OK = sourceDoc.Open(filePaths(fileIndex))
Debug.Print "(" & fileIndex & ") SOURCE DOC OPENED & PDDOC SET: " & OK
' Get start and end pages
startPage = Range("E" & CStr(fileRows(fileIndex))).Value
endPage = Range("F" & CStr(fileRows(fileIndex))).Value
OK = primaryDoc.InsertPages(insertPoint, sourceDoc, startPage, endPage-startPage+1, False)
Debug.Print "(" & fileIndex & ") " & endPage-startPage+1 & " PAGES INSERTED SUCCESSFULLY: " & OK
Set sourceDoc = Nothing
Next fileIndex
OK = primaryDoc.Save(PDSaveFull, filePaths(1))
Debug.Print "primaryDoc SAVED PROPERLY: " & OK
Set primaryDoc = Nothing
acroExchangeApp.Exit
Set acroExchangeApp = Nothing
MsgBox "DONE"
End Sub

Answer 2

You can try deleting the unwanted parts of each pdf prior to appending them all together with sourceDoc.DeletePages(startPage, endPage) for example:
OK = sourceDoc.Open(FilePaths(colIndex))
startPage = Range("C" & colIndex)
endPage = Range("D" & colIndex)
OK = sourceDoc.DeletePages(1, startPage - 1)
OK = sourceDoc.DeletePages(endPage - startPage + 2, sourceDoc.GetNumPages) ' just some arithmetic
Debug.Print "(" & colIndex & ") SOURCE DOC OPENED & PDDOC SET: " & OK
You would just need to specify startPage and endPage for each in columns C & D... or you can change this snippet and specificy them however you prefer

Answer 3

EXPLANATION:
For First Code I removed everything but the barebones: filepath to the doc being appended to and filepaths to the file that we are getting the pages that are to be appended into primary doc.
I set up a constant for us and set it to 2. We can set it to 3 or 5 etc. This constant will be passed in the PAGE TO END part of the insertpage function. I have a feeling that you are going to say that there is some relationship between total num of pages in a pdf and the num to append, but this is not clear from OP
BREAKING DOWN INSERTPAGES():
INSERTPAGES(the page number where insertion starts (inside primaryDoc), a path to the PDF that is the source of the insertion pages (sourcedoc pathway), page to start from (sourceDoc), page to end (sourceDoc), true or false whether books are inserted too
CODE BAREBONES:
Option Explicit
Sub AppendPDF()
Dim app As Object
Dim acroDoc As Object
Dim filePaths As Collection
Dim pathwayIterator As Range
Dim primaryDoc As Object
Dim OK As String
Dim numPages As Long
Dim colIndex As Long
Dim sourceDoc As Object
Const finalPage = 2
Set app = CreateObject("Acroexch.app")
Set acroDoc = New AcroPDDoc
Set filePaths = New Collection
For Each pathwayIterator In Range("A2:A100")
If pathwayIterator.Value <> "" Then
filePaths.Add pathwayIterator.Value2
End If
Next pathwayIterator
Set primaryDoc = CreateObject("AcroExch.PDDoc")
OK = primaryDoc.Open(filePaths(1))
Debug.Print "PRIMARY DOC OPENED & PDDOC SET: " & OK
For colIndex = 2 To filePaths.Count
numPages = primaryDoc.GetNumPages() - 1
Set sourceDoc = CreateObject("AcroExch.PDDoc")
OK = sourceDoc.Open(filePaths(colIndex))
Debug.Print "(" & colIndex & ") SOURCE DOC OPENED & PDDOC SET: " & OK
OK = primaryDoc.InsertPages(numPages, sourceDoc, 0, finalPage, False)
Debug.Print "(" & colIndex & ") PAGES INSERTED SUCCESSFULLY: " & OK
sourceDoc.Close
Set sourceDoc = Nothing
Next colIndex
OK = primaryDoc.Save(PDSaveFull, filePaths(1))
Debug.Print "PRIMARYDOC SAVED PROPERLY: " & OK
Set primaryDoc = Nothing
app.Exit
Set app = Nothing
MsgBox "DONE"
End Sub
CODE EXTRA:
Here we added a bit more. I am not sure what you are doing with the file lengths, I have a feeling that you are going to link them with the number of pages to append. Here we make two collections, one with pathways to the files we are working with a second holds the number of pages of each of these files
Option Explicit
Sub AppendPDF()
Dim app As Object
Dim acroDoc As Object
Dim filePaths As Collection
Dim pgnumber As Range
Dim pageNum As Long
Dim FileNumPages As Collection
Dim pathwayIterator As Range
Dim primaryDoc As Object
Dim OK As String
Dim numPages As Long
Dim colIndex As Long
Dim sourceDoc As Object
Const finalPage = 2
Set app = CreateObject("Acroexch.app")
Set acroDoc = New AcroPDDoc
Set filePaths = New Collection
'Counts # of pages in each pdf, loads to column D.
For Each pgnumber In Range("A2:A100")
If Not IsEmpty(pgnumber) Then
acroDoc.Open pgnumber
pageNum = acroDoc.GetNumPages
Cells(pgnumber.Row, 4) = pageNum
End If
acroDoc.Close
Next pgnumber
'Append to this file, ideally will be a front page to append to, commented out for now.
'FilePaths.Add "\path\name\here"
'Active or not feature in Column B, Specify Yes to include in combination, no to exclude
Set filePaths = New Collection
Set FileNumPages = New Collection
For Each pathwayIterator In Range("A2:A100")
If pathwayIterator.Value <> "" Then
filePaths.Add pathwayIterator.Value2
FileNumPages.Add Cells(pathwayIterator.Row, 4)
End If
Next pathwayIterator
'Combine files which are listed in Column A.
Set primaryDoc = CreateObject("AcroExch.PDDoc")
OK = primaryDoc.Open(filePaths(1))
Debug.Print "PRIMARY DOC OPENED & PDDOC SET: " & OK
For colIndex = 2 To filePaths.Count
numPages = primaryDoc.GetNumPages() - 1
Set sourceDoc = CreateObject("AcroExch.PDDoc")
OK = sourceDoc.Open(filePaths(colIndex))
Debug.Print "(" & colIndex & ") SOURCE DOC OPENED & PDDOC SET: " & OK
OK = primaryDoc.InsertPages(numPages, sourceDoc, 0, finalPage, False)
Debug.Print "(" & colIndex & ") PAGES INSERTED SUCCESSFULLY: " & OK
sourceDoc.Close
Set sourceDoc = Nothing
Next colIndex
OK = primaryDoc.Save(PDSaveFull, filePaths(1))
Debug.Print "PRIMARYDOC SAVED PROPERLY: " & OK
Set primaryDoc = Nothing
app.Exit
Set app = Nothing
MsgBox "DONE"
End Sub