Print as PDF then add to a selected existing PDF

[one4youman]

Hi,

I am trying to find a way to print / export several sheets from a workbook as a PDF and to then combine the new PDF to an existing PDF.

My thought process is this:
1. Print / export several sheets from a workbook and save the PDF in a temporary folder.
2. A dialog box would then open asking you to browse to the existing PDF that you wish to combine with the previously created temporary PDF.
3. A dialog box would open prompting you to browse to where you would like to save and to name the merged file.
4. Clean up and delete the temporary PDF.

I have tried several different codes and have not had much luck finding a solution to the above. Most of the codes I have found rely upon entering the file path and names in cells which I am trying to avoid.

Thank you in advance for any assistance,
John

 

[one4youman]

John, this is exactly what I have been trying to accomplish for the past year and works perfectly!

One last question for you, when I click YES under prompt = "Do you want append a PDF to the sheets PDF file?" would it be possible to select multiple PDF’s within this folder, click “OPEN” and then prompt = "Do you want append another PDF to the sheets PDF file?" where you can again select either a single PDF or multiple PDF’s in a different folder to then be combined?

I tried changing the AllowMultiSelect to true, which will allow for the multiple selections, however when I go to save the merged file several of the multi selected PDF’s are not included.

Thank you so much for your assistance.

 

[John_w]

I'm really pleased to hear that it works perfectly!

For selecting multiple PDFs, as well as setting AllowMultiSelect = True, we need to loop through the SelectedItems array, which is the array of full file names selected by the user. The previous code used SelectedItems(1), so it only appended the first selected file, even if multiple files are selected. The other change is to change the selectedPDFfile variable to a Variant, instead of a String, to allow For Each looping through an array.

'References
'Adobe Acrobat nn.0 Type Library

Option Explicit

Public Sub Save_Sheets_As_PDF_and_Merge_Other_PDFs3()

    Dim objCAcroPDDocDestination As Acrobat.CAcroPDDoc
    Dim objCAcroPDDocSource As Acrobat.CAcroPDDoc
    Dim outputPDFfile As String, selectedPDFfile As Variant
    Dim i As Integer, PDFindex As Integer
    Dim prompt As String, numAppended As Integer
    
    'Create Acrobat API objects
    
    Set objCAcroPDDocDestination = CreateObject("AcroExch.PDDoc")
    Set objCAcroPDDocSource = CreateObject("AcroExch.PDDoc")
    
    outputPDFfile = Environ("TEMP") & "\Sheets_" & Format(Now, "hhmmss") & ".pdf"
    
    Save_Visible_Sheets_As_PDF outputPDFfile
    prompt = "Do you want append any PDFs to the sheets PDF file?"
    numAppended = 0
    
    While MsgBox(prompt, vbYesNo) = vbYes
    
        With Application.FileDialog(msoFileDialogOpen)
            .Title = "Select the PDF file(s) to append to the sheets PDF file"
            .AllowMultiSelect = True
            .Filters.Add "PDF files", "*.pdf"
            
            If .Show Then
            
                objCAcroPDDocDestination.Open outputPDFfile
                Debug.Print outputPDFfile & ": " & objCAcroPDDocDestination.GetNumPages & " pages"
                
                For Each selectedPDFfile In .SelectedItems
                
                    objCAcroPDDocSource.Open selectedPDFfile
                    Debug.Print selectedPDFfile & ": " & objCAcroPDDocSource.GetNumPages & " pages"
                
                    If objCAcroPDDocDestination.InsertPages(objCAcroPDDocDestination.GetNumPages - 1, objCAcroPDDocSource, 0, objCAcroPDDocSource.GetNumPages, 0) Then
                        Debug.Print "Appended " & selectedPDFfile & " to " & outputPDFfile
                    Else
                        Debug.Print "Error appending " & selectedPDFfile & " to " & outputPDFfile
                        MsgBox "Error appending " & selectedPDFfile & " to " & outputPDFfile
                    End If
                
                    Debug.Print outputPDFfile & ": " & objCAcroPDDocDestination.GetNumPages & " pages"
                    objCAcroPDDocSource.Close
                    numAppended = numAppended + 1
                    
                Next
                                
                objCAcroPDDocDestination.Save 1, outputPDFfile
                objCAcroPDDocDestination.Close
                                
            End If
            
        End With
    
        prompt = "Do you want append more PDFs to the sheets PDF file?"
    
    Wend
        
    'Release Acrobat objects
    
    Set objCAcroPDDocSource = Nothing
    Set objCAcroPDDocDestination = Nothing
    
    'Save final PDF with file name and location chosen by user
    
    With Application.FileDialog(msoFileDialogSaveAs)
        PDFindex = 0
        For i = 1 To .Filters.Count
            'Debug.Print .Filters(i).Description
            If InStr(VBA.UCase(.Filters(i).Description), "PDF") > 0 Then PDFindex = i
        Next
        .Title = IIf(numAppended = 0, "Save sheets PDF file", "Save merged PDF file")
        .FilterIndex = PDFindex
        If .Show Then
            Debug.Print outputPDFfile & " saved as " & .SelectedItems(1)
            Name outputPDFfile As .SelectedItems(1)
        Else
            Kill outputPDFfile
        End If
    End With
    
End Sub


Private Sub Save_Visible_Sheets_As_PDF(fullPDFfileName As String)

    Dim currentSheet As Worksheet
    Dim replaceSelected As Boolean
    Dim ws As Worksheet
    
    Set currentSheet = ThisWorkbook.ActiveSheet
    
    With ThisWorkbook
        replaceSelected = True
        For Each ws In .Worksheets
            If ws.Visible = xlSheetVisible Then
                ws.Select replaceSelected
                replaceSelected = False
            End If
        Next
        .ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=fullPDFfileName, _
            Quality:=xlQualityMinimum, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
        .Worksheets(1).Select True
    End With
    
    currentSheet.Select
    
End Sub

 

[John_w]

What happened to your reply?

"damaniam1604 has just replied to a thread you have subscribed to entitled - Print as PDF then add to a selected existing PDF - in the Excel Questions forum of MrExcel Message Board."