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]

1. Flatten each PDF prior to combining.

You can call the Acrobat API flattenPages method.

Add the following declaration:

    Dim JSO As Object

And add the following lines after every PDF you open, for example after newdoc.Open DL_Files_Dir & "TOC.pdf"

    Set JSO = newdoc.GetJSObject
    JSO.flattenPages

Change newdoc according to the object variable name of the PDF being opened.

 

[rjtaylor]

OMG That did it thanks

 

[rjtaylor]

OMG That did it thanks

I spoke to soon still not working

 

[John_w]

Please give more detail - what exactly isn't working? Which part?

Repost your code, with Option Explicit at the top of the module and all the variables declared.

 

[rjtaylor]

I tried it on the above code. However, I did not realize that I was only opening that one file.
So, I wrote the following to iterate through the files in a folder.
It is now throwing the error at JSO.flattenPages

Option Explicit
Sub Flattentest()
Dim JSO As Object, newdoc As Object
Dim strFile As String, folderdir As String

setVarables
folderdir = "C:\Users\Rodney J-CTR Taylor\Documents\testFolder\PDFtoFlatten\"
strFile = Dir(folderdir)
Do While Len(strFile) > 0
    Set newdoc = CreateObject("AcroExch.PDDoc")
'    MsgBox strFile
    newdoc.Open strFile
    Set JSO = newdoc.GetJSObject
    JSO.flattenPages
    strFile = Dir
Loop
End Sub

 

[John_w]

It is now throwing the error at JSO.flattenPages

What's the exact error?

    newdoc.Open folderdir & strFile

should fix it.

 

[rjtaylor]

I was getting the following (Object variable or with block variable not set)
After changing to newdoc.Open folderdir & strFile I now get this (NotAllowedError: Security settings prevent access to this property or method).

 

[John_w]

After changing to newdoc.Open folderdir & strFile I now get this (NotAllowedError: Security settings prevent access to this property or method).

You'll have to remove security from the PDF. I don't think this can be done programmatically.

 

[rjtaylor]

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