I have some code in Access 2010 VBA that reads records and creates a single PDF from multiple linked PDF's with bookmarks. This code works fine:
<<<< CODE begin >>>>>
Private Sub BuildDatabook_Click()
On Error GoTo Err_BuildDatabook_Click
Dim sqlStr As String
Dim rst As DAO.Recordset
Dim vFiles() As String
Dim iNrOfFiles As Long
Dim iNrOfIncorrectFiles As Long
Dim sPDFFileName As String
Dim sPDFBookMark As String
Dim sNewPDFFileName As String
sNewPDFFileName = "\\sample\" & Me.Order_Id & "\Data_Book\10000_" & Format(Now(), "YYYYMMDDhhnn") & ".pdf"
iNrOfFiles = 0
iNrOfIncorrectFiles = 0
sqlStr = "SELECT * FROM TABLE WHERE Order_ID = '10000'"
Set rst = CurrentDb.OpenRecordset(sqlStr, dbOpenDynaset, dbSeeChanges)
Do While Not rst.EOF
sPDFFileName = rst("FileName")
sPDFBookMark = rst("BookMark")
If Len(Dir(sPDFFileName)) = 0 Then
iNrOfIncorrectFiles = iNrOfIncorrectFiles + 1
Else
ReDim Preserve vFiles(1, iNrOfFiles)
vFiles(0, iNrOfFiles) = sPDFFileName
vFiles(1, iNrOfFiles) = sPDFBookMark
iNrOfFiles = iNrOfFiles + 1
End If
rst.MoveNext
Loop
rst.Close
Set rst = Nothing
If iNrOfFiles > 0 Then
If iNrOfIncorrectFiles = 0 Then
updfConcatenate vFiles, sNewPDFFileName
Else
updfConcatenate vFiles, sNewPDFFileName
MsgBox sNewPDFFileName & " File Created, but " & iNrOfIncorrectFiles & " file(s) could not be found."
End If
Application.FollowHyperlink sNewPDFFileName, , True
Else
MsgBox "No valid files found to be merged", vbInformation, "Build Databook PDF"
End If
DoCmd.Hourglass False
End If
Exit_BuildDatabook_Click:
Exit Sub
Err_BuildDatabook_Click:
MsgBox err.Description
Resume Exit_BuildDatabook_Click
End Sub
Sub updfConcatenate(pvarFromPaths() As String, pstrToPath As String)
'http://stackoverflow.com/questions/5514176/merging-pdfs-programatically-while-maintaining-the-combin...
Dim origPdfDoc As Acrobat.CAcroPDDoc
Dim newPdfDoc As Acrobat.CAcroPDDoc
Dim lngNewPageCount As Long
Dim lngInsertPage As Long
Dim I As Long
Set origPdfDoc = CreateObject("AcroExch.PDDoc")
Set newPdfDoc = CreateObject("AcroExch.PDDoc")
If newPdfDoc.Open(pvarFromPaths(0, 0)) = True Then
updfInsertBookmark pvarFromPaths(1, 0), lngInsertPage, , newPdfDoc
mlngBkmkCounter = 1
For I = 1 To UBound(pvarFromPaths, 2)
If origPdfDoc.Open(pvarFromPaths(0, I)) = True Then
lngInsertPage = newPdfDoc.GetNumPages
newPdfDoc.InsertPages lngInsertPage - 1, origPdfDoc, 0, origPdfDoc.GetNumPages, False
If pvarFromPaths(1, I) <> "" Then
updfInsertBookmark pvarFromPaths(1, I), lngInsertPage, , newPdfDoc
mlngBkmkCounter = mlngBkmkCounter + 1
End If
origPdfDoc.Close
End If
Next I
newPdfDoc.Save PDSaveFull, pstrToPath
End If
ExitHere:
Set origPdfDoc = Nothing
Set newPdfDoc = Nothing
Exit Sub
End Sub
Public Sub updfInsertBookmark(pstrCaption As String, plngPage As Long, _
Optional pstrPath As String, _
Optional pMyPDDoc As Acrobat.CAcroPDDoc, _
Optional plngIndex As Long = -1, _
Optional plngParentIndex As Long = -1)
Dim MyPDDoc As Acrobat.CAcroPDDoc
Dim jso As Object
Dim BMR As Object
Dim arrParents As Variant
Dim bkmChildsParent As Object
Dim bleContinue As Boolean
Dim bleSave As Boolean
Dim lngIndex As Long
If pMyPDDoc Is Nothing Then
Set MyPDDoc = CreateObject("AcroExch.PDDoc")
bleContinue = MyPDDoc.Open(pstrPath)
bleSave = True
Else
Set MyPDDoc = pMyPDDoc
bleContinue = True
End If
If plngIndex > -1 Then
lngIndex = plngIndex
Else
lngIndex = mlngBkmkCounter
End If
If bleContinue = True Then
Set jso = MyPDDoc.GetJSObject
Set BMR = jso.BookmarkRoot
If plngParentIndex > -1 Then
arrParents = jso.BookmarkRoot.Children
Set bkmChildsParent = arrParents(plngParentIndex)
bkmChildsParent.createchild pstrCaption, "this.pageNum= " & plngPage, lngIndex
Else
BMR.createchild pstrCaption, "this.pageNum= " & plngPage, lngIndex
End If
MyPDDoc.SetPageMode 3 '3 — display using bookmarks'
If bleSave = True Then
MyPDDoc.Save PDSaveIncremental, pstrPath
MyPDDoc.Close
End If
End If
ExitHere:
Set jso = Nothing
Set BMR = Nothing
Set arrParents = Nothing
Set bkmChildsParent = Nothing
Set MyPDDoc = Nothing
End Sub
<<<< CODE end >>>>>
What i would like to do is when saving the file, reduce the final pdf file size as much as possible.
I don't see any parameters on the PdfDoc.Save that could cause the reduction in file size (hoping there is, just have not found it yet)
I see other Save options like PDSaveCompressed in PDSaveFlags2, but do not know how to get them to work or which ones to choose:
PDDocSaveParams
PDDocSaveWithParams
enum PDSaveFlags2 {
PDSaveUncompressed = 1 << 0,
PDSaveCompressed = 1 << 1,
PDSaveCompressStructureOnly = 1 << 2,
PDSaveRemoveASCIIFilters = 1 << 3,
PDSaveAddFlate = 1 << 4,
PDSaveReplaceLZW = 1 << 5,
PDSaveOptimizeXObjects = 1 << 6,
PDSaveOptimizeContentStreams = 1 << 7,
PDSaveOptimizeFonts = 1 << 8,
PDSaveOptimizeMarkedJBIG2Dictionaries = 1 << 9,
PDSaveEnsure7bitASCII = 1 << 10,
PDSaveAutoSave = 1 << 11,
PDSaveOverrideCollections = 1 << 12
}
If none of the above will reduce the pdf file size, I have found other options like PDFOptPDFVersion - setting it to 0x00090000 for Acrobat 9 and up, but again cannot find any examples on how to use it:
AVDocDoSaveAsWithParams ()
PDFOptPDFVersion enmAcrobatVersion - can set the version to support to (like acrobat 9 and up)
PDFOptObjectCompression - not sure what the enumerations are on this one.
struct _t_PDFOptParams {
ASSize_t size;
ASPathName asPathDest;
ASFileSys fileSys;
ProgressMonitor progMon;
void* progMonClientData;
PDFOptPDFVersion enmAcrobatVersion; 0x00090000
PDFOptImageOptionsRec imageOptionsColor;
PDFOptImageOptionsRec imageOptionsGrayscale;
PDFOptImageOptionsRec imageOptionsMonochrome;
PDFont* arrPDFontsToUnembed;
ASInt32 cPDFontsToUnembed;
PDFOptFlattenTransparencyOptions pdfOptFlattenTransparencyOptions;
ASBool bRemoveFormActions;
ASBool bFlattenFormFields;
ASBool bRemoveJavascriptActions;
ASBool bRemoveAlternateImages;
ASBool bRemoveThumbnails;
ASBool bRemoveDocumentTags;
ASBool bSmoothenLines;
ASBool bMergeImageFragments;
ASBool bRemovePrintSettings;
ASBool bRemoveSrchIndex;
ASBool bRemoveBookmarks;
ASBool bRemoveCommentsAndWidgets;
ASBool bRemoveDocInfoAndMetadata;
ASBool bRemoveObjectData;
ASBool bRemoveFileAttachments;
ASBool bRemoveCrossRefs;
ASBool bRemovePrivateData;
ASBool bFlattenVisibleLayers;
PDFOptObjectCompression enmObjectCompression;
ASBool bUnencodedToFlate;
ASBool bLZWToFlate;
ASBool bRemoveInvalidBookmarks;
ASBool bRemoveInvalidLinks;
ASBool bRemoveUnreferencedNamedDests;
ASBool bLinearize;
ASBool bSkipIrreducibleImages;
ASBool bSubsetEmbeddedFonts;
ASBool bOptimizeContentStms;
}
But again, can't find any examples on how to use these collections.
Any help would be greatly Appreciated!
AdChoices