Help, Adobe Acrobat DC combine VBA Code used to work but not anymore

BalloutMoe

Board Regular
Joined
Jun 4, 2021
Messages
137
Office Version
  1. 365
Platform
  1. Windows
Hello all,
I have a code that I have used for several months with no issues at all. However today I tried it and its not combining the pdf files whatsoever. I tried a few things but with no result. I even tried repairing the installation from inside Adobe Acrobat DC, also no help. Can anyone please help? Below is the code. Thank you

VBA Code:
Sub SaveActiveSheetsAsPDF()


Dim excelfilename As String, shopfilename As String, shopname3 As String
Dim filename2 As String, shopname As String, shopname2 As String, shopname4 As String
filename2 = Application.ActiveWorkbook.FullName
shopname2 = Mid(filename2, 27)
ary = Split(shopname2, "\")
shopname3 = ary(UBound(ary))
Debug.Print shopname3
ary = Split(shopname3, ".xlsx")
'Create and assign variables
shopname4 = ary(LBound(ary))
Debug.Print shopname4
Dim saveLocation As String, savelocation2 As String

saveLocation = ActiveWorkbook.ActiveSheet.Range("AJ1")
savelocation2 = ActiveWorkbook.ActiveSheet.Range("AJ2")

'Write PDF Names
Dim objFSO As Scripting.FileSystemObject

Set location = ActiveWorkbook.ActiveSheet.Range("AA:AA")
Range("AA1:AE55").ClearContents
Dim objfile As Scripting.File
Dim objFolder As Scripting.Folder
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(saveLocation)
Dim i As Integer
i = 2
For Each objfile In objFolder.Files
Debug.Print objfile.Name
location.Cells(i, 1) = objfile.Path
i = i + 1

Next
'Save Active Sheet(s) as PDF
Dim FileExt As String
FileExt = ".pdf"
ActiveWorkbook.ActiveSheet.Range("AA1").value = savelocation2 & shopname4 & FileExt
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
    FileName:=savelocation2 & shopname4 & FileExt

'Write PDF Names


'Combine PDF

 Dim objCAcroPDDocDestination As Acrobat.CAcroPDDoc
    Dim objCAcroPDDocSource As Acrobat.CAcroPDDoc
    Dim PDFfiles As Range, PDFfile As Range
    Dim n As Long
   
   With ActiveWorkbook.ActiveSheet
        Set PDFfiles = .Range("AA1", .Cells(.rows.Count, "AA").End(xlUp))
    End With
 
   
   
    'Create Acrobat API objects
   
    Set objCAcroPDDocDestination = CreateObject("AcroExch.PDDoc")
    Set objCAcroPDDocSource = CreateObject("AcroExch.PDDoc")
   
    'Open first PDF file and merge other PDF files into it
   
    n = 0
    For Each PDFfile In PDFfiles
        n = n + 1
        If n = 1 Then
            objCAcroPDDocDestination.Open PDFfile.value
        Else
            objCAcroPDDocSource.Open PDFfile.value
            If Not objCAcroPDDocDestination.InsertPages(objCAcroPDDocDestination.GetNumPages - 1, objCAcroPDDocSource, 0, objCAcroPDDocSource.GetNumPages, 0) Then
                MsgBox "Error merging " & PDFfile.value
            End If
            objCAcroPDDocSource.Close
        End If
    Next
    Debug.Print FileName
    'Save merged PDF files as a new file
   
    objCAcroPDDocDestination.Save 1, ActiveWorkbook.ActiveSheet.Range("AA1")
    objCAcroPDDocDestination.Close
   
    Set objCAcroPDDocSource = Nothing
    Set objCAcroPDDocDestination = Nothing

    MsgBox "Created " & ActiveWorkbook.ActiveSheet.Range("AA1")
   
End Sub
 

Excel Facts

How to find 2nd largest value in a column?
MAX finds the largest value. =LARGE(A:A,2) will find the second largest. =SMALL(A:A,3) will find the third smallest
I got this issue resolved if anybody encounters the same issue. I uninstalled Adobe then did a clean install on it and the code works again.
 
Upvote 0
Solution

Forum statistics

Threads
1,214,788
Messages
6,121,582
Members
449,039
Latest member
Arbind kumar

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