VBA error in Merging Multiple PDF files

hassanleo1987

Board Regular
Joined
Apr 19, 2017
Messages
56
Hi,

I am trying using this code to merge PDF files that can range from 2 to 16 in the same directory as the workbook.

VBA Code:
Sub MergePDF()

Dim n As Long, PDFfileName As String
Dim i As Integer
Dim objCAcroPDDocDestination As Acrobat.CAcroPDDoc
Dim objCAcroPDDocSource As Acrobat.CAcroPDDoc

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

objCAcroPDDocDestination.Open (ThisWorkbook.Path & "\Part - 1.pdf")
n = 1
    Do
        n = n + i
        For i = 1 To 16
            PDFfileName = Dir(ThisWorkbook.Path & "\Part - " & n & ".pdf")
        Next i
        If PDFfileName <> "" Then
            objCAcroPDDocSource.Open ThisWorkbook.Path & "\" & PDFfileName
            If objCAcroPDDocDestination.InsertPages(objCAcroPDDocDestination.GetNumPages - 1, objCAcroPDDocSource, 0, objCAcroPDDocSource.GetNumPages, 0) Then
            Else
            End If
            objCAcroPDDocSource.Close
        End If
    Loop While PDFfileName <> ""

objCAcroPDDocDestination.Save 1, ThisWorkbook.Path & "\ABC 20211000.pdf" 'Change the Final file name here
objCAcroPDDocDestination.Close
        
Set objCAcroPDDocSource = Nothing
Set objCAcroPDDocDestination = Nothing

Kill (ThisWorkbook.Path & "\Part - *.pdf")
MsgBox "PDF Transformation Completed"

End Sub

Previously my PDF files were generated with fixed name following a series i.e., Part - 1, Part - 2, Part - 3 to Part - 16.
But recently I have changed the logic in main macro which now produces the same files but had to skip some parts sometime.
Meaning the series now looks like

Part - 1
Part - 2
Part - 3
Part - 5
Part - 7
Part - 9
Part - 10
Part - 12
Part - 14
Part - 16

I am trying to use the counter by adding this part :

VBA Code:
n = n + i
        For i = 1 To 16
            PDFfileName = Dir(ThisWorkbook.Path & "\Part - " & n & ".pdf")
        Next i

Previously n = n + 1 was working just fine with successive series number from 1 to 16.
Now when I try to run a code, I get this error :

Run-time error '-2147417854 (80010105)':
Method 'Close' of Object CAcroPDDoc Failed.

I have check the acrobat add-in is enabled in my excel.

Please take a look and advice me on how to fix this issue.
 

Excel Facts

Which came first: VisiCalc or Lotus 1-2-3?
Dan Bricklin and Bob Frankston debuted VisiCalc in 1979 as a Visible Calculator. Lotus 1-2-3 debuted in the early 1980's, from Mitch Kapor.
Made a work around. Though It takes around 30 seconds to do the job but it is working.
VBA Code:
Sub MergePDF()

Dim n As Integer, PDFfileName As String
Dim i As Integer
Dim objCAcroPDDocDestination As Acrobat.CAcroPDDoc
Dim objCAcroPDDocSource As Acrobat.CAcroPDDoc

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

objCAcroPDDocDestination.Open (ThisWorkbook.Path & "\Part - 1.pdf")

For n = 1 To 16
    PDFfileName = Dir(ThisWorkbook.Path & "\Part - " & n & ".pdf")
    If PDFfileName <> "" Then
            objCAcroPDDocSource.Open ThisWorkbook.Path & "\" & PDFfileName
            If objCAcroPDDocDestination.InsertPages(objCAcroPDDocDestination.GetNumPages - 1, objCAcroPDDocSource, 0, objCAcroPDDocSource.GetNumPages, 0) Then
            Else
            End If
            objCAcroPDDocSource.Close
        End If
    Next n
'n = 1
'    Do
'        n = n + 1
'        If PDFfileName <> "" Then
'            objCAcroPDDocSource.Open ThisWorkbook.Path & "\" & PDFfileName
'            If objCAcroPDDocDestination.InsertPages(objCAcroPDDocDestination.GetNumPages - 1, objCAcroPDDocSource, 0, objCAcroPDDocSource.GetNumPages, 0) Then
'            Else
'            End If
'            objCAcroPDDocSource.Close
'        End If
'    Loop While PDFfileName <> ""

objCAcroPDDocDestination.Save 1, ThisWorkbook.Path & "\ABC 20211000.pdf" 'Change the Final file name here
'objCAcroPDDocDestination.Close
        
Set objCAcroPDDocSource = Nothing
Set objCAcroPDDocDestination = Nothing

Kill (ThisWorkbook.Path & "\Part - *.pdf")
MsgBox "PDF Transformation Completed"

End Sub

Still, If somebody has a better something better, Please do share your input!
 
Upvote 0
Can any one please help
to fix this post
 

Attachments

  • Capture.PNG
    Capture.PNG
    54.8 KB · Views: 42
Upvote 0

Forum statistics

Threads
1,223,901
Messages
6,175,277
Members
452,629
Latest member
SahilPolekar

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top