VBA error in Merging Multiple PDF files

[hassanleo1987]

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.

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 :

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.

 

[hassanleo1987]

Made a work around. Though It takes around 30 seconds to do the job but it is working.

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!

 

[SamrahAhmed]

Can any one please help
to fix this post