VBA Code Problem Merging PDF Files (1 Viewer)

Rich1968 · Jul 14, 2011

I have a piece of code that i'm trying to use to combine 8 "PDF" files. I run the code and it will not create the new file. I've been at this for 2 weeks and i'm close but no cigar....

HELP!
Rich1968

Here's the code. I use access 2003 and Acrobat 6.0

Function MergePDF()

'Relies on the Adobe Acrobat 6.0 Type Library
Dim objCAcroPDDocDestination As Acrobat.CAcroPDDoc
Dim objCAcroPDDocSource As Acrobat.CAcroPDDoc
Dim fso As Scripting.FileSystemObject
Dim f As File
Dim fldr As Folder

'Initialize the objects
Set fso = New Scripting.FileSystemObject
Set fldr = fso.GetFolder("C:\Edocs\")

Set objCAcroPDDocDestination = CreateObject("AcroExch.PDDoc")
Set objCAcroPDDocSource = CreateObject("AcroExch.PDDoc")

'Open Destination, all other documents will be added to this and saved with
'a new filename

objCAcroPDDocDestination.Open ("C:\Edocs\CMS Proposal.pdf")

'Do your loop here to open subsequent documents that you want to add

For Each f In fldr.Files
If InStr(f.Name, "*.pdf") Then

'Open the source document that will be added to the destination

objCAcroPDDocSource.Open (f)

If objCAcroPDDocDestination.InsertPages(objCAcroPDDocDestination.GetNumPages - 1, objCAcroPDDocSource, 0, objCAcroPDDocSource.GetNumPages, 0) Then

MsgBox "Documents Merged!"
End If
Else
MsgBox "You have a problem"
End If
Next f

objCAcroPDDocSource.close

objCAcroPDDocDestination.Save 1, "C:\Edocs\CMS Proposal.pdf"
objCAcroPDDocDestination.close
Set objCAcroPDDocSource = Nothing
Set objCAcroPDDocDestination = Nothing

End Function

boblarson · Jul 14, 2011

Here's my merge code that I use if it helps:

Code:

Function MergeThePDFs(ByRef strMergeNames() As String, strPath As String, strFInalOutputDoc As String, blnKillIndFiles As Boolean) As Boolean
    Dim acroOrigPdfDoc As Object 'Acrobat.CAcroPDDoc
    Dim acroNewPdfDoc As Object 'Acrobat.CAcroPDDoc
    Dim varOrigTotalPages As Long
    Dim varNewTotalPages As Long
    Dim strReportPathName As String
    Dim strDoc2Insert As String
    Dim i As Integer
    Dim varsplit As Variant
    Dim varSplit2 As Variant
    Dim strMergeInputFile As String
      
On Error GoTo Errors
    
    varsplit = Split(strFInalOutputDoc, "|", , vbTextCompare)
    strMergeInputFile = varsplit(0)
    strReportPathName = strPath
    varsplit = Split(strMergeNames(0), "|", , vbTextCompare)

    Set acroOrigPdfDoc = CreateObject("AcroExch.PDDoc")
    Set acroNewPdfDoc = CreateObject("AcroExch.PDDoc")
    'Open the first file.  That is what will be appended to
    '    If acroOrigPdfDoc.Open(varSplit(0)) Then
    If acroOrigPdfDoc.Open(strMergeInputFile) Then
        For i = 0 To UBound(strMergeNames)
            varsplit = Split(strMergeNames(i), "|", , vbTextCompare)
            varOrigTotalPages = acroOrigPdfDoc.GetNumPages
            If acroNewPdfDoc.Open(varsplit(0)) Then
                'Get total # of pages to insert
                varNewTotalPages = acroNewPdfDoc.GetNumPages
                'Insert pages into original pdf
                acroOrigPdfDoc.InsertPages varOrigTotalPages - 1, acroNewPdfDoc, 0, _
                                           varNewTotalPages, False
                'Save doc
                '                acroOrigPdfDoc.Save PDSaveIncremental, strMergeInputFile 'path doesn't matter, will save to original doc
                acroOrigPdfDoc.Save PDSaveCopy, strMergeInputFile
                acroNewPdfDoc.Close
            Else
                MsgBox "Failed to open doc "
            End If
        Next i
        acroOrigPdfDoc.Save PDSaveCopy, strFInalOutputDoc
        acroNewPdfDoc.Close
        '        acroOrigPdfDoc.Close
    End If
    '        MsgBox "Pages added to " & path3
    MergeThePDFs = True
    'Close docs
    If Dir(strPath) <> "" Then
        Kill strPath
    End If
    Set acroOrigPdfDoc = Nothing
    Set acroNewPdfDoc = Nothing
    
    ' rename the report cover file to the actual file name we want
    Name strMergeInputFile As strPath
    
    ' delete individual files if the checkbox was checked on the form
    If blnKillIndFiles Then
        For i = 0 To UBound(strMergeNames)
            varsplit = Split(strMergeNames(i), "|", , vbTextCompare)
            Kill varsplit(0)
        Next i
    End If

ExitHere:
     Exit Function
Errors:
            MergeThePDFs = False
            MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure MergeThePDFs of Module basAcrobat2", , CurrentDb.Properties("AppTitle")
            Resume ExitHere
            Resume
           
End Function

Rich1968 · Jul 21, 2011

Hey Bob,

Thanks for the code. I am trying to take 8 pdf files and combining them into one. I finally came back to your code after I relized the code I posted will only combine 2 pdf's not 8.

I tried your code and got the following error "Type Mismatch". Here's the inputs.

MergeThePDFs ("*.pdf","C:\Edocs\","C:\CMS Proposal.pdf","C:\Edocs\")

This is something stupid on my part, Please help?

Many Thanks
Rich1968

boblarson · Jul 21, 2011

The MergeThePDFs function takes an ARRAY as input, not just a delimited string. So, you would either need to create the actual array prior to the call and then pass the array object you have created, or you would need to rewrite the MergerThePDFs function to take a delimited string instead of an array (which would NOT be the solution I would use).

Rich1968 · Jul 21, 2011

Thanks Bob,

Wish this was easier. I'm not a pro at VBA. I know enough to be very dangerious.

How would I set up an "Array"

Humbled
Rich1968

Rich1968 · Jul 21, 2011

Hey Bob,

I found this code on PlanetSourceCode.Com. It works GREAT! Thought I'd pass it on. Thanks for your help.

Option Compare Database

'**************************************
' Name: Merge Multiple PDF Files
' Description:Convert / Merge Multiple PDF documents into a single PDF Document
' with Bookmarks using the multiple pdf file names.
' By: Brad G Skidmore
'
'
' Inputs:None
'
' Returns:True or False
'
'Assumes:Ref Scripting FSO, and Adobe Ac
' robat Found in Adobe5.0 SDK .
'Again
'You must have Adobe Acrobat 5.0 SDK Installed

'otherwise you will get errors when Late Binding the AdobeDocument Objects duh!
'
'Side Effects:None
'This code is copyrighted and has limite
' d warranties.
'Please see http://www.Planet-Source-Cod
' e.com/xq/ASP/txtCodeId.61810/lngWId.1/qx
' /vb/scripts/ShowCode.htm
'for details.
'**************************************

Function MergePDFFiles(psRawPDFFilesDir As String, _
psSinglePDFOutputDir As String, _
psSinglePDFOutputName As String) As Boolean
On Error GoTo EH
Dim lErrNum As Long
Dim sErrDesc As String
Dim sMess As String
Dim bFirstDoc As Boolean
Dim sRawPDFFilesDir As String
Dim sSinglePDFOutputDir As String
Dim sSinglePDFOutputName As String
Dim oMainDoc As Acrobat.CAcroPDDoc
Dim oTempDoc As Acrobat.CAcroPDDoc
'Need to use Adobe internal Java Object
'in order to Add Book marks
Dim oJSO As Object 'JavaScript Object
Dim oBookMarkRoot As Object
Dim oFolder As Scripting.Folder
Dim saryFileSort() As String
Dim oFile As Scripting.File
Dim oFSO As Scripting.FileSystemObject
Dim sBMName As String
Dim lPos As Long
Dim lFile As Long
Dim lBMPageNo As Long
sRawPDFFilesDir = psRawPDFFilesDir
sSinglePDFOutputDir = psSinglePDFOutputDir
sSinglePDFOutputName = psSinglePDFOutputName
Set oFSO = New Scripting.FileSystemObject
Set oFolder = oFSO.GetFolder(sRawPDFFilesDir)
bFirstDoc = True

If oFolder.Files.Count = 0 Then
Exit Function
End If
'Because the FSO folder files collection

' does not allow for
'Native sorting, need to plug all the fi
' les into an array and sort that motha
ReDim saryFileSort(1 To oFolder.Files.Count)
lFile = 0

For Each oFile In oFolder.Files
lFile = lFile + 1
saryFileSort(lFile) = oFile.Name
Next
'do your sort here, or not
'goUtil.utBubbleSort saryFileSort

For lFile = 1 To UBound(saryFileSort, 1)

If LCase(Right(saryFileSort(lFile), 4)) = ".pdf" Then

If bFirstDoc Then
bFirstDoc = False
Set oMainDoc = CreateObject("AcroExch.PDDoc")
oMainDoc.Open sRawPDFFilesDir & saryFileSort(lFile)
Set oJSO = oMainDoc.GetJSObject
Set oBookMarkRoot = oJSO.BookMarkRoot
sBMName = saryFileSort(lFile)
lPos = InStr(1, sBMName, "_{", vbBinaryCompare)

If lPos > 0 Then
sBMName = Left(sBMName, lPos - 1) & ".pdf"
End If
oBookMarkRoot.CreateChild sBMName, "this.pageNum =0", lFile - 1
Else
Set oTempDoc = CreateObject("AcroExch.PDDoc")
oTempDoc.Open sRawPDFFilesDir & "\" & saryFileSort(lFile)
'get the Book mark page number before th
' e actual instert of new pages
lBMPageNo = oMainDoc.GetNumPages
oMainDoc.InsertPages oMainDoc.GetNumPages - 1, oTempDoc, 0, oTempDoc.GetNumPages, 1
oTempDoc.close
sBMName = saryFileSort(lFile)
lPos = InStr(1, sBMName, "_{", vbBinaryCompare)

If lPos > 0 Then
sBMName = Left(sBMName, lPos - 1) & ".pdf"
End If
oBookMarkRoot.CreateChild sBMName, "this.pageNum =" & lBMPageNo, lFile - 1
End If
End If
Next
oMainDoc.Save 1, sSinglePDFOutputDir & "\" & sSinglePDFOutputName
oMainDoc.close
MergePDFFiles = True
CLEAN_UP:
Set oFolder = Nothing
Set oFile = Nothing
Set oFSO = Nothing
Set oBookMarkRoot = Nothing
Set oJSO = Nothing
Set oMainDoc = Nothing
Set oTempDoc = Nothing
Exit Function
EH:
lErrNum = err.Number
sErrDesc = err.Description
MergePDFFiles = False
'Enter you error handler
Set oFolder = Nothing
Set oFile = Nothing
Set oFSO = Nothing
Set oBookMarkRoot = Nothing
Set oJSO = Nothing
Set oMainDoc = Nothing
Set oTempDoc = Nothing
End Function

VBA Code Problem Merging PDF Files (1 Viewer)

Rich1968

Registered User.

boblarson

Smeghead

Rich1968

Registered User.

boblarson

Smeghead

Rich1968

Registered User.

Rich1968

Registered User.

Similar threads

Users who are viewing this thread