Combining PDF into one file and flatting them as needed

[rjtaylor]

I have code that goes online grabs all the files in a location. I then convert them into individual PDFs
I then have the code below to combine them into one file
My problem is that some of the PDFs are fillable and have the same form names in them. My two choices are either:
1. Flatten each PDF prior to combining.
2. Add then into one PDF as a portfoliofile
Here is the combining code where I get my errors on some files.

Sub CombFilesFromWorksheetnames()
setprintarea

'SaveWorksheet as PDF
strName = "TOC"
strPathFile = DL_Files_Dir & strName & ".pdf"

'export to PDF in current folder
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:=strPathFile

'---combine and delete pdfs---'
'DirLocation = ThisWorkbook.Path & "\"
lRow = Cells(Rows.Count, 3).End(xlUp).Row
    Dim objFSO As Object, objFolder As Object, objFile As Object
    Dim strFolderPath As String
    Dim strFilePaths As String
    
    ' Use the Adobe Acrobat Application to combine the PDF files
    Dim AcroApp As Object, PartDocs As Object, AVDoc As Object
    Dim newdoc As Object, i As Integer
    
    ' Create a new instance of Adobe Acrobat
    'Set AcroApp = CreateObject("AcroExch.App")
    Set PartDocs = CreateObject("AcroExch.PDDoc")
    Set newdoc = Nothing
    
    ' Create a File System Object
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    
    ' Get the folder object
    Set objFolder = objFSO.GetFolder(DL_Files_Dir)
    
    'start PDF with TOC
'    Set newdoc = CreateObject("AcroExch.PDDoc")
'    newdoc.Open OutPut_Dir
'    newdoc.Save 1, OutPut_Dir & "\" & "TOC.pdf"
Set newdoc = CreateObject("AcroExch.PDDoc")
newdoc.Open DL_Files_Dir & "TOC.pdf"
newdoc.Save 1, OutPut_Dir & "\" & CaseFileName & ".pdf"
                
For Each cell In Range("D4:D" & lRow)
    If cell.Value <> "" Then
        pos = InStrRev(cell.Value, ".")
'        MsgBox Left(Cell.Value, pos)
        fn = Left(cell.Value, pos)
        PartDocs.Open DL_Files_Dir & fn & "pdf"
        If Not newdoc.InsertPages(newdoc.GetNumPages - 1, PartDocs, 0, PartDocs.GetNumPages, 0) Then
'            MsgBox "Error merging " & cell.Value, vbExclamation
            MsgBox cell.Value & vbCrLf & vbCrLf & "This file type is not supported. You will need to convert it to a PDF manually if you want it added to the Case File"
        End If

        PartDocs.Close
    End If
Next
'    get filename and find in folder
    For Each cell In Range("D4:D" & lRow)
        If cell.Value <> "" Then
        ' Loop through each file in the folder
            For Each objFile In objFolder.Files
                ' Check if the file is a PDF file
                pos1 = InStrRev(objFile.Name, ".")
                pos2 = InStrRev(cell.Value, ".")
                If Left(objFile.Name, pos1) = Left(cell.Value, pos2) Then
                    If LCase(objFile.Name) Like LCase("*" & ".pdf") Then
                        If newdoc Is Nothing Then
                            Set newdoc = CreateObject("AcroExch.PDDoc")
                            newdoc.Open objFile.Path
                            newdoc.Save 1, OutPut_Dir & "\" & CaseFileName & ".pdf"
                        Else
                            PartDocs.Open objFile.Path
                            If Not newdoc.InsertPages(newdoc.GetNumPages - 1, PartDocs, 0, PartDocs.GetNumPages, 0) Then
                                MsgBox "Error merging " & objFile.Path, vbExclamation
                            End If
                            PartDocs.Close
                        End If
                        objFile.Delete
                    End If
                End If
            Next objFile
        End If
    Next
    
    ' Save the final combined PDF document
    newdoc.Save 1, OutPut_Dir & "\" & CaseFileName & ".pdf"
    ' Close the merged PDF file
    newdoc.Close
End Sub

Can anyone lead me in how to first flatten these PDFs or to arrange them into a portfolio?

 

[John_w]

Ok but I can print to PDF and this flattens it without security issues. Would you know how to do that through code

Printing a PDF to a PDF is possible using the Acrobat command line and a named PDF printer. The command to run from VBA to print a single PDF is:

"C:\path\to\Acrobat.exe" /n /s /o /h /t "C:\path\to\My file.pdf" "A PDF Printer"

The problem is that PDF printers prompt the user for the output file name, which we want to avoid. I created a new Windows printer, named "My Print to PDF", based on the Microsoft Print to PDF driver, which prints to a local port configured as a fixed file name, for example "C:\Temp\Print.pdf". I also created a non-prompting printer based on the Adobe PDF driver, but the output file it creates is always zero bytes long.

With the new "My Print to PDF" printer the command is:

"C:\path\to\Acrobat.exe" /n /s /o /h /t "C:\path\to\My file.pdf" "My Print to PDF"

which creates "C:\Temp\Print.pdf". You would then have a VBA loop which runs the above command for each PDF file and copies "C:\Temp\Print.pdf" back to the PDF file (or a new PDF file).

 

[rjtaylor]

Printing a PDF to a PDF is possible using the Acrobat command line and a named PDF printer. The command to run from VBA to print a single PDF is:

"C:\path\to\Acrobat.exe" /n /s /o /h /t "C:\path\to\My file.pdf" "A PDF Printer"

The problem is that PDF printers prompt the user for the output file name, which we want to avoid. I created a new Windows printer, named "My Print to PDF", based on the Microsoft Print to PDF driver, which prints to a local port configured as a fixed file name, for example "C:\Temp\Print.pdf". I also created a non-prompting printer based on the Adobe PDF driver, but the output file it creates is always zero bytes long.

With the new "My Print to PDF" printer the command is:

"C:\path\to\Acrobat.exe" /n /s /o /h /t "C:\path\to\My file.pdf" "My Print to PDF"

which creates "C:\Temp\Print.pdf". You would then have a VBA loop which runs the above command for each PDF file and copies "C:\Temp\Print.pdf" back to the PDF file (or a new PDF file).

This might be the answer I need Can you give me a code example. Also, when you set up the Printer is that through code or do you need to manually do this. I ask because I need to share my final program with others.

 

[rjtaylor]

Another example I tried is this code. The problem is it flashes Adobe which is Adobe PRO DC. and appears to run smoothly. The end result however is no change to the PDF files.

Sub flatten_folder()

Dim MyFile As String

myPath = InputBox("enter the path to the folder where the pdf files are located **must end with \**")

MyFile = Dir(myPath)

Do While MyFile <> ""

If MyFile Like "*.pdf" Or MyFile Like "*.pdf" Then

fullpath = myPath & MyFile

Set app = CreateObject("acroexch.app")

Set AVDoc = CreateObject("acroexch.avdoc")

Set pddoc = CreateObject("acroexch.pddoc")

Set aform = CreateObject("aformaut.app")

pddoc.Open (fullpath)

Set AVDoc = pddoc.OpenAVDoc(fullpath)

   js = "this.flattenpages();"

     '//execute the js code

    aform.Fields.executethisjavascript js



Set pddoc = AVDoc.GetPDDoc

pddoc.Save PDSaveFull, fullpath

pddoc.Close

Set aform = Nothing

Set AVDoc = Nothing

Set app = Nothing

End If

MyFile = Dir

Loop

End Sub

 

[John_w]

Also, when you set up the Printer is that through code or do you need to manually do this.

Add a new printer manually.

This might be the answer I need Can you give me a code example.

Something like this:

Option Explicit

#If VBA7 Then
    Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
    Private Declare PtrSafe Function ShellExecute Lib "shell32" Alias "ShellExecuteA" (ByVal hWnd As LongPtr, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
#Else
    Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
    Private Declare Function ShellExecute Lib "shell32" Alias "ShellExecuteA" (ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
#End If

Private Const SW_HIDE As Long = 0&


Public Sub Print_PDFs_In_Folder()

    Dim matchPDFfiles As String
    Dim PDFprinterName As String, PDFprinterFile As String
    Dim folder As String, PDFfile As String
    
    matchPDFfiles = "C:\path\to\folder\*.pdf"
    
    PDFprinterName = "My Print to PDF"
    PDFprinterFile = "C:\Temp\Excel\PDF\Print.pdf"
    
    folder = Left(matchPDFfiles, InStrRev(matchPDFfiles, "\"))
    
    If Dir(PDFprinterFile) <> vbNullString Then Kill PDFprinterFile
    
    PDFfile = Dir(matchPDFfiles)
    While PDFfile <> vbNullString
    
        'Print the PDF asynchronously to the printer file
        
        ShellExecute_Print folder & PDFfile, PDFprinterName
        
        'Loop until the printer file exists, is complete (a Permission denied error occurs if FileCopy is attempted and
        'the printer file is still being written to) and has been copied to the destination file
        
        On Error Resume Next
        Do
            DoEvents
            Sleep 200
            Err.Clear
            FileCopy PDFprinterFile, folder & PDFfile
        Loop Until Err.Number = 0
        On Error GoTo 0
        Kill PDFprinterFile
    
        PDFfile = Dir
    Wend
        
End Sub


Private Sub ShellExecute_Print(file As String, Optional PrinterName As String)
    If PrinterName = "" Then
        ShellExecute Application.hWnd, "PrintTo", file, vbNullString, 0&, SW_HIDE
    Else
        ShellExecute Application.hWnd, "PrintTo", file, Chr(34) & PrinterName & Chr(34), 0&, SW_HIDE
    End If
End Sub

Note that ShellExecute runs the default .pdf file handler to print the PDFs.

But before adding a new printer and trying the code, I would check that printing a PDF with Microsoft Print to PDF does indeed remove security from the PDF.