[Okta Webinar] Learn how to a build a cloud-first strategyRegister Now

x
?
Solved

Append Pdf pages with Distiller from Excel VBA

Posted on 2011-04-30
6
Medium Priority
?
778 Views
Last Modified: 2012-05-11
Dave,

How do I need to adapt your solution Private Sub MergePDF in order just to append three pdf files together to a new one, without printing anything from the active sheet. Pdf paths stored as follows:

Dim ExistingPdf1 As String
Dim ExistingPdf2 As String
Dim ExistingPdf3 As String
Dim NewMergedPdf As String

ExistingPdf1 = ActiveSheet.Range("A1").Value
ExistingPdf2 = ActiveSheet.Range("A2").Value
ExistingPdf3 = ActiveSheet.Range("A3").Value
NewMergedPdf = ActiveSheet.Range("A4").Value

Open in new window

0
Comment
Question by:stmoritz
  • 4
  • 2
6 Comments
 
LVL 42

Expert Comment

by:dlmille
ID: 35498989
Sorry about the delay.  Are all 4 PDF's files that are saved?  You just need a routine to merge the 4 files?

Dave
0
 
LVL 42

Expert Comment

by:dlmille
ID: 35499160
Ok - anticipating your response it that they're all saved files, here's a routine that looks in Column A, starting at A1 for as many rows as you have data in that row (so nothing else but these file names in that column - at least for how I wrote it).

The app opens the first doc, then inserts pages on successive doc's opening/closing them as it goes, then it prompts you for a saveas filename (overwriting without warning) and gives you an option to preview the results.

Code here:

Option Explicit

Type myPDDOC_Type
    Filepath As String
    openResult As Variant
    objCAcroPDDOC As Object
End Type

Sub MergePDF_Files()
'Relies on the Adobe Acrobat X.X Type Library - just add Tools->References->Acrobat and it will work, accordingly
Dim objAcroApp As Object, avDOC As Object
Dim myPDDOC() As myPDDOC_Type, i As Integer
Dim basePDDOC As Object
Dim myPDDocFile As Range
Dim mergeResult As Variant
Dim sFile As String, saveResult As Variant
Dim xMsg As Long

    'Initialize the objects
    Set objAcroApp = CreateObject("AcroExch.App")

    i = 0
    For Each myPDDocFile In Range("A1", Range("A" & Rows.Count).End(xlUp)) 'look for contiguous range for files to merge
        ReDim Preserve myPDDOC(i) As myPDDOC_Type
        myPDDOC(i).Filepath = myPDDocFile.Value
        i = i + 1
    Next myPDDocFile
    

    For i = 0 To UBound(myPDDOC)
        Set myPDDOC(i).objCAcroPDDOC = CreateObject("AcroExch.PDDoc")
        myPDDOC(i).openResult = myPDDOC(i).objCAcroPDDOC.Open(myPDDOC(i).Filepath)
        If i = 0 Then
            Set basePDDOC = myPDDOC(0).objCAcroPDDOC
        Else ' start merging using InsertPages method on the first document
            'mergeResult = myPDDOC(0).objCAcroPDDOC.InsertPages(i - 1, myPDDOC(i).objCAcroPDDOC, 0, 1, 0)
            'InsertPages (See Acrobat API Reference for parameters)
            mergeResult = basePDDOC.InsertPages(basePDDOC.GetNumPages - 1, myPDDOC(i).objCAcroPDDOC, 0, myPDDOC(i).objCAcroPDDOC.GetNumPages, 0)
            myPDDOC(i).objCAcroPDDOC.Close
            Set myPDDOC(i).objCAcroPDDOC = Nothing
        End If
    Next i
        
    sFile = Application.GetSaveAsFilename(filefilter:="PDF Files (*.pdf), *.pdf", Title:="Select Save As Filename for Merged PDF File")
    
    If sFile <> "False" Then
        saveResult = basePDDOC.Save(1, sFile)
        xMsg = MsgBox("Documents Merged!  Open and Review?", vbYesNo, "Hit Yes to open PDF for review")
        
        If xMsg = vbYes Then
            
            objAcroApp.Show
            
            Set avDOC = basePDDOC.OpenAVDoc("")
            
            MsgBox "Hit Ok to close it out and continue...", vbOKOnly, "Hit Ok, Ok? :)"
            
            objAcroApp.Hide
            
            avDOC.Close (True)

            Set avDOC = Nothing
        End If
    End If
    
    'do cleanup routine
    basePDDOC.Close
    Set basePDDOC = Nothing
    objAcroApp.Exit
    Set objAcroApp = Nothing
    
End Sub

Open in new window



See attached.

Hope this is hitting the target!

Enjoy!

Dave
PDF-Merge-r1.xlsm
0
 

Author Comment

by:stmoritz
ID: 35500293
Dave, this is great stuff. I have increased to 500. Amazing.

Last questions:
1) If instead putting the path of the pdf's (already saved) to be merged in A1... but in named ranges, for example PdfPath1 PdfPath2 PdfPath3, how do I need to change the code... I guess removing the loop
 i = 0
    For Each myPDDocFile In Range("A1", Range("A" & Rows.Count).End(xlUp)) 'look for contiguous range for files to merge
        ReDim Preserve myPDDOC(i) As myPDDOC_Type
        myPDDOC(i).Filepath = myPDDocFile.Value
        i = i + 1
    Next myPDDocFile

Open in new window

and what else?

2) if the name of the merged pdf is in a range or cell, I just change
    sFile = Application.GetSaveAsFilename(filefilter:="PDF Files (*.pdf), *.pdf", Title:="Select Save As Filename for Merged PDF File")

Open in new window

to for example this, right:
    sFile = Range("MergedPdfFilePath").Value

Open in new window

0
VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

 
LVL 42

Expert Comment

by:dlmille
ID: 35500301
For the first, if you put your PDF Path in a list somewhere:
Change:
For Each myPDDocFile In Range("A1", Range("A" & Rows.Count).End(xlUp)) 'look for contiguous range for files to merge

To:
For Each myPDDocFile in Range("your named range of files")

Open in new window


Yes, you could assign them all individually, just increment the array myPDDOC() by one for each add...

>>2) if the name of the merged pdf is in a range or cell, I just change

Yes, that's correct
0
 
LVL 42

Accepted Solution

by:
dlmille earned 2000 total points
ID: 35500328
Do this:

 
Dim pdfPathsString As String
Dim pdfPathArray() As String

    pdfPathsString = "PDFPath1,PDFPath2,PDFPath3,PDFPath4"
    pdfPathArray = Split(pdfPathsString, ",")

    'Initialize the objects
    Set objAcroApp = CreateObject("AcroExch.App")

    'i = 0
    'For Each myPDDocFile In Range("A1", Range("A" & Rows.Count).End(xlUp)) 'look for contiguous range for files to merge
    '    ReDim Preserve myPDDOC(i) As myPDDOC_Type
    '    myPDDOC(i).Filepath = myPDDocFile.Value
    '    i = i + 1
    'Next myPDDocFile
    

    For i = 0 To UBound(pdfPathArray)
        ReDim Preserve myPDDOC(i) As myPDDOC_Type
        myPDDOC(i).Filepath = Evaluate(pdfPathArray(i))
        
        Set myPDDOC(i).objCAcroPDDOC = CreateObject("AcroExch.PDDoc")

Open in new window


See attached, where the app looks at PDFPath1,2, 3, and 4 - named ranges

Dave
PDF-Merge-r2.xlsm
0
 

Author Closing Comment

by:stmoritz
ID: 35500374
first class. excellent. thank you very much.
0

Featured Post

What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This article descibes how to create a connection between Excel and SAP and how to move data from Excel to SAP or the other way around.
If you need to forecast numbers -- typically for finance -- the Windows and Mac versions of Excel 2016 have a basket of tools to get the job done.
The viewer will learn how to use a discrete random variable to simulate the return on an investment over a period of years, create a Monte Carlo simulation using the discrete random variable, and create a graph to represent the possible returns over…
This Micro Tutorial will demonstrate the scrolling table in Microsoft Excel using the INDEX function.

834 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question