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

 

[Derek Brown]

A long time ago I used the professional version of PDF reDirect from VBA:
http://www.exp-systems.com/forum_exp/forum_topics.asp?FID=7
May be worth check this out.

 

[one4youman]

Thanks Derek, but not exactly what I am looking for.

I am looking for a code that when run prints all of the visible worksheets to a PDF and then to prompts you asking if you wish to attach another PDF to the newly created PDF.

If you choose YES:
msoFileDialogFolderPicker (Or similar) opens and you browse to the existing PDF and click open. Another msoFileDialogFolderPicker prompts you to select where and how you want to save the combined file.
The Printed PDF sheets and the Selected Existing PDF are then combined and output to the save file name / location.

If you click NO:
msoFileDialogFolderPicker prompts you to select where to save the PDF that was created.

Bonus points if anyone can also come up with a way that after you choose the existing PDF to add to the newly created PDF, if another prompt asks you if you wish to attach another PDF, and continues on a loop until you click no.

Thank you in advance for any assistance,
John

 

[John_w]

Do you have Acrobat Professional installed? PDF files can be merged (i.e. one PDF joined to the end of another PDF) using the Acrobat API, which is only available with Acrobat Professional. See https://www.mrexcel.com/forum/excel...dfs-into-one-pdf-post5107148.html#post5107148 for example code.

 

[one4youman]

Do you have Acrobat Professional installed? PDF files can be merged (i.e. one PDF joined to the end of another PDF) using the Acrobat API, which is only available with Acrobat Professional. See https://www.mrexcel.com/forum/excel...dfs-into-one-pdf-post5107148.html#post5107148 for example code.

I am looking for something similar but instead of entering the path\file names in a cell to combine I want it to create a PDF of the open workbook and to ask which PDF to attach to the new pdf. I then want it to ask where to save the new merged PDF.

 

[one4youman]

Do you have Acrobat Professional installed? PDF files can be merged (i.e. one PDF joined to the end of another PDF) using the Acrobat API, which is only available with Acrobat Professional. See https://www.mrexcel.com/forum/excel...dfs-into-one-pdf-post5107148.html#post5107148 for example code.

And yes, I do have Acrobat Professional.

 

[John_w]

I am looking for a code that when run prints all of the visible worksheets to a PDF and then to prompts you asking if you wish to attach another PDF to the newly created PDF.

If you choose YES:
msoFileDialogFolderPicker (Or similar) opens and you browse to the existing PDF and click open. Another msoFileDialogFolderPicker prompts you to select where and how you want to save the combined file.
The Printed PDF sheets and the Selected Existing PDF are then combined and output to the save file name / location.

If you click NO:
msoFileDialogFolderPicker prompts you to select where to save the PDF that was created.

Bonus points if anyone can also come up with a way that after you choose the existing PDF to add to the newly created PDF, if another prompt asks you if you wish to attach another PDF, and continues on a loop until you click no.

Thank you in advance for any assistance,
John

Hopefully this macro works as described above. In the VBA editor you must set a reference to Adobe Acrobat nn.0 Type Library, via the Tools -> References menu.

'References
'Adobe Acrobat nn.0 Type Library

Option Explicit


Public Sub Save_Sheets_As_PDF_and_Merge_Other_PDFs()

    Dim objCAcroPDDocDestination As Acrobat.CAcroPDDoc
    Dim objCAcroPDDocSource As Acrobat.CAcroPDDoc
    Dim sheetsPDFfile As String, selectedPDFfile As String
    Dim saved As Boolean
    Dim i As Integer, PDFindex As Integer
    
    'Create Acrobat API objects
    
    Set objCAcroPDDocDestination = CreateObject("AcroExch.PDDoc")
    Set objCAcroPDDocSource = CreateObject("AcroExch.PDDoc")
    
    sheetsPDFfile = Environ("TEMP") & "\Sheets_" & Format(Now, "hhmmss") & ".PDF"
    
    Save_Visible_Sheets_As_PDF sheetsPDFfile
    saved = False
    
    While MsgBox("Do you want append another PDF to the sheets PDF file?", vbYesNo) = vbYes
    
        With Application.FileDialog(msoFileDialogOpen)
            .Title = "Select a PDF file to append to the sheets PDF file"
            .AllowMultiSelect = False
            .Filters.Add "PDF files", "*.pdf"
            
            If .Show Then
            
                selectedPDFfile = .SelectedItems(1)
                objCAcroPDDocDestination.Open sheetsPDFfile
                objCAcroPDDocSource.Open selectedPDFfile
                If Not objCAcroPDDocDestination.InsertPages(objCAcroPDDocDestination.GetNumPages - 1, objCAcroPDDocSource, 0, objCAcroPDDocSource.GetNumPages, 0) Then
                    MsgBox "Error merging " & selectedPDFfile
                End If
                objCAcroPDDocSource.Close
                
                With Application.FileDialog(msoFileDialogSaveAs)
                    PDFindex = 0
                    For i = 1 To .Filters.Count
                        If InStr(VBA.UCase(.Filters(i).Description), "PDF") > 0 Then PDFindex = i
                    Next
                    .Title = "Save merged PDF file"
                    .FilterIndex = PDFindex
                    
                    If .Show Then
                    
                        objCAcroPDDocDestination.Save 1, .SelectedItems(1)
                        objCAcroPDDocDestination.Close
                        saved = True
                        
                    End If
                    
                End With
            
            End If
            
        End With
    
    Wend
    
    If Not saved Then
    
        With Application.FileDialog(msoFileDialogSaveAs)
            PDFindex = 0
            For i = 1 To .Filters.Count
                If InStr(VBA.UCase(.Filters(i).Description), "PDF") > 0 Then PDFindex = i
            Next
            .Title = "Save sheets PDF file"
            .FilterIndex = PDFindex
            If .Show Then
                Name sheetsPDFfile As .SelectedItems(1)
                saved = True
            End If
        End With
    
    End If
        
    Set objCAcroPDDocSource = Nothing
    Set objCAcroPDDocDestination = Nothing
    
    Kill sheetsPDFfile

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

 

[Derek Brown]

All that you originally wanted is possible using the VBA API within PDF reDirect. However, you would need a good understanding of VBA to be able to do so. I know that I would be able to easily do that but unfortunately I am not very well, so I am not able to help you with the VBA.

 

[one4youman]

Thank you for the code; this is the closest I have come to what I have been attempting to accomplish.

However, it would appear that the code is not looping correctly.

When asked if I want to select a PDF to add to the new PDF, I select “Yes” and I am prompted to select the PDF to be added.

After selecting and clicking open, I am then prompted to save the new file instead of it looping back to ask if I have another PDF to attach.

It then prompts again asking if I would like to add another PDF, if I select yes then it opens a selection box to select another PDF.

When I click open it then prompts me to save the file, and then goes back to the prompt asking if I want to add another.

The PDF printed from the worksheet should have the 2 selected PDF’s (Or however many are selected within the loop) combined together into a final PDF.

For Example, if the worksheet printed to a PDF is 1 page and you select a PDF with 2 Pages and another PDF with 3 pages, the output file should be 6 pages total.

I believe there is an error in the loop between where you select the files to add and the save as dialog. There is also an error with the Kill command.

Any additional help would be greatly appreciated.

Thank you,
John

 

[John_w]

Sorry, I interpreted your request as requiring multiple output PDFs, each with zero or one other PDF appended.

Try this macro instead - it creates the sheets PDF and then prompts to append zero or more PDFs, creating a single output PDF with all the selected PDFs appended to the sheets PDF and saved with a user-selected file name. I hope this works as you require.

The Debug.Print statements output to the VBA Immediate Window (press Ctrl+G in the VBA editor to display it) and show the macro's progress.

'References
'Adobe Acrobat 10.0 Type Library

Option Explicit

Public Sub Save_Sheets_As_PDF_and_Merge_Other_PDFs2()

    Dim objCAcroPDDocDestination As Acrobat.CAcroPDDoc
    Dim objCAcroPDDocSource As Acrobat.CAcroPDDoc
    Dim outputPDFfile As String, selectedPDFfile As String
    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 a PDF to the sheets PDF file?"
    numAppended = 0
    
    While MsgBox(prompt, vbYesNo) = vbYes
    
        With Application.FileDialog(msoFileDialogOpen)
            .Title = "Select a PDF file to append to the sheets PDF file"
            .AllowMultiSelect = False
            .Filters.Add "PDF files", "*.pdf"
            
            If .Show Then
            
                selectedPDFfile = .SelectedItems(1)
                objCAcroPDDocDestination.Open outputPDFfile
                Debug.Print outputPDFfile & ": " & objCAcroPDDocDestination.GetNumPages & " pages"
                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
                objCAcroPDDocDestination.Save 1, outputPDFfile
                objCAcroPDDocDestination.Close
                numAppended = numAppended + 1
                                
            End If
            
        End With
    
        prompt = "Do you want append another PDF 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