Remember To Do the Following....
Use [Code].... [/Code] tags when posting code to the thread.
Mark your thread as Solved if satisfied by using the Thread Tools options.
If posting the same issue to another forum please show the link
Hi guys,
Can anyone please help me? I need to have this macro reference a cell which determines the location of the PDF's. The locations and the names of the pdf's change for every job, based off the business name.
For example, cell A1 says C:\ACME Motors\Form\ACME Motors - Form.pdf
And A2 says C:\ACME Motors\Office Documents\ACME Motors - Office Form.pdf
And I need the merged PDF to be saved at A3 which says C:\ACME Motors\Final Documents\ACME Motors - Signed.pdf
Sub Main() Const DestFile As String = "MergedFile.pdf" ' <-- change to suit Dim MyPath As String, MyFiles As String Dim a() As String, i As Long, f As String ' Choose the folder or just replace that part by: MyPath = Range("E3") With Application.FileDialog(msoFileDialogFolderPicker) '.InitialFileName = "C:\Temp\" .AllowMultiSelect = False If .Show = False Then Exit Sub MyPath = .SelectedItems(1) DoEvents End With
Hi and welcome to VBAExpress!
Try this version of the code:
Best Regards!Sub Main() Dim MyFiles As String, DestFile As String With ActiveSheet MyFiles = .Range("A1").Value & "," & .Range("A2").Value DestFile = .Range("A3").Value End With Call MergePDFs01(MyFiles, DestFile) End Sub Sub MergePDFs01(MyFiles As String, DestFile As String) ' ZVI:2016-12-10 http://www.vbaexpress.com/forum/showthread.php?47310&p=353568&viewfull=1#post353568 ' Reference required: VBE - Tools - References - Acrobat Dim a As Variant, i As Long, n As Long, ni As Long Dim AcroApp As New Acrobat.AcroApp, PartDocs() As Acrobat.AcroPDDoc a = Split(MyFiles, ",") ReDim PartDocs(0 To UBound(a)) On Error GoTo exit_ If Len(Dir(DestFile)) Then Kill DestFile For i = 0 To UBound(a) ' Check PDF file presence If Dir(Trim(a(i))) = "" Then MsgBox "File not found" & vbLf & a(i), vbExclamation, "Canceled" Exit For End If ' Open PDF document Set PartDocs(i) = New Acrobat.AcroPDDoc ' CreateObject("AcroExch.PDDoc") PartDocs(i).Open Trim(a(i)) If i Then ' Merge PDF to PartDocs(0) document ni = PartDocs(i).GetNumPages() If Not PartDocs(0).InsertPages(n - 1, PartDocs(i), 0, ni, True) Then MsgBox "Cannot insert pages of" & vbLf & a(i), vbExclamation, "Canceled" End If ' Calc the amount of pages in the merged document n = n + ni ' Release the memory PartDocs(i).Close Set PartDocs(i) = Nothing Else ' Calc the amount of pages in PartDocs(0) document n = PartDocs(0).GetNumPages() End If Next If i > UBound(a) Then ' Save the merged document to DestFile If Not PartDocs(0).Save(PDSaveFull, DestFile) Then MsgBox "Cannot save the resulting document" & vbLf & DestFile, vbExclamation, "Canceled" End If End If exit_: ' Inform about error/success If Err Then MsgBox Err.Description, vbCritical, "Error #" & Err.Number ElseIf i > UBound(a) Then MsgBox "The resulting file is created:" & vbLf & DestFile, vbInformation, "Done" End If ' Release the memory If Not PartDocs(0) Is Nothing Then PartDocs(0).Close Set PartDocs(0) = Nothing ' Quit Acrobat application AcroApp.Exit 'DoEvents: DoEvents Set AcroApp = Nothing End Sub
Hi ZVI, all,
the first code worked well posted by ZVI (on page 1), however, I am having issues in adjusting the Destfile to include a variable date "lg_cob" as per below. Any way to make it work as currently the code just ingores it and saves it as constant.
thanks
Const Destfile = "MergedFile" & lg_cob & ".pdf" ' The name of the merged file
Sub MergePDFs() ' --> Settings, change to suit Const MyPath = "C:\Temp" ' Path where PDF files are stored Const MyFiles = "1.pdf,2.pdf,3.pdf" ' List of PDFs to ne merged Const DestFile = "MergedFile.pdf" ' The name of the merged file ' <-- End of settings Dim a As Variant, i As Long, n As Long, ni As Long, p As String Dim AcroApp As New Acrobat.AcroApp, PartDocs() As Acrobat.CAcroPDDoc If Right(MyPath, 1) = "\" Then p = MyPath Else p = MyPath & "\" a = Split(MyFiles, ",") ReDim PartDocs(0 To UBound(a)) On Error GoTo exit_ If Len(Dir(p & DestFile)) Then Kill p & DestFile For i = 0 To UBound(a) ' Check PDF file presence If Dir(p & Trim(a(i))) = "" Then MsgBox "File not found" & vbLf & p & a(i), vbExclamation, "Canceled" Exit For End If ' Open PDF document Set PartDocs(i) = CreateObject("AcroExch.PDDoc") PartDocs(i).Open p & Trim(a(i)) If i Then ' Merge PDF to PartDocs(0) document ni = PartDocs(i).GetNumPages() If Not PartDocs(0).InsertPages(n - 1, PartDocs(i), 0, ni, True) Then MsgBox "Cannot insert pages of" & vbLf & p & a(i), vbExclamation, "Canceled" End If ' Calc the number of pages in the merged document n = n + ni ' Release the memory PartDocs(i).Close Set PartDocs(i) = Nothing Else ' Calc the number of pages in PartDocs(0) document n = PartDocs(0).GetNumPages() End If Next If i > UBound(a) Then ' Save the merged document to DestFile If Not PartDocs(0).Save(PDSaveFull, p & DestFile) Then MsgBox "Cannot save the resulting document" & vbLf & p & DestFile, vbExclamation, "Canceled" End If End If exit_: ' Inform about error/success If Err Then MsgBox Err.Description, vbCritical, "Error #" & Err.Number ElseIf i > UBound(a) Then MsgBox "The resulting file is created:" & vbLf & p & DestFile, vbInformation, "Done" End If ' Release the memory If Not PartDocs(0) Is Nothing Then PartDocs(0).Close Set PartDocs(0) = Nothing ' Quit Acrobat application AcroApp.Exit Set AcroApp = Nothing End Sub
Hi Johny,
Try this adjusted part of the code:
If i > UBound(a) Then Dim lg_cob As String, f As String lg_cob = Format(Now, "_yyyy-mm-dd") f = Replace(DestFile, ".pdf", lg_cob & ".pdf") ' Save the merged document to DestFile If Not PartDocs(0).Save(PDSaveFull, p & f) Then MsgBox "Cannot save the resulting document" & vbLf & p & f, vbExclamation, "Canceled" End If End If exit_:
Hi ZVI,
spacibo, but it, sadly, did not work... i have a pretty hefty code i've inherited and there are a lot of reference.
As a quick fix, maybe you can suggest a code where I can open the saved PDF and save it with an updated name?
Something like, open "MergedFile.pdf", save as "MergedFile2.pdf". Rest I should figure out myself.
thanks again!
Hi,
Can you please help me as well, I need to save all the files in a folder(pdf files)(whatever be the name) by converting them to a single file using Adobe to another folder. some of the files in the folder(which are to be converted to a single) are password protected also. please HELP, Thanks!!
Welcome to the forum! Please start your own thread. http://www.vbaexpress.com/forum/newt...newthread&f=17
You can reference this thread if needed. If links can not be posted yet, list thread 47310 as the reference.
I guess you want all the files merged into one file? I guess all the files have the same password? I guess that you mean Adobe Acrobat and NOT Adobe Reader?
Thanks!! I have posted a new thread. And only 3 files are password protected.. I need total 5 files to be converted into one and saved to another location