m_in_spain
Board Regular
- Joined
- Sep 28, 2018
- Messages
- 72
- Office Version
- 365
- Platform
- Windows
Excel produces me various .pdf files, some i then combine to produce, for example a drawing pack.
What i now need to do is select some, but not all, of the pdf files in the folder, in a particular order (rather than just reading down the list)
The code i am using to combine the files is:
and
My problem is that this takes every .pdf in the folder and combines them in the alphabetical order they are in the folder.
I am using Adobe Acrobat X pro, Excel & Word 2016
I am still new to this so any help is appreciated..but it needs to be easy to follow instructions!
Many thanks
What i now need to do is select some, but not all, of the pdf files in the folder, in a particular order (rather than just reading down the list)
The code i am using to combine the files is:
Code:
Sub Make_Final_PDF()
Dim Doc_Folder As String
Dim Project_Folder As String
Dim mainPDF As String
Dim endpath As String
Sheet33.Visible = xlSheetVisible
Sheet33.Select
Const DestFile As String = "Final.pdf"
Dim MyPath As String, MyFiles As String
Dim a() As String, i As Long, f As String
Dim Path As String
Dim Location As String
Dim myName As String
MyPath = ActiveWorkbook.Path & "\"
ReDim a(1 To 2 ^ 14)
f = Dir(MyPath & "*.pdf")
While Len(f)
If StrComp(f, DestFile, vbTextCompare) Then
i = i + 1
a(i) = f
End If
f = Dir()
Wend
If i Then
ReDim Preserve a(1 To i)
MyFiles = Join(a, ",")
Application.StatusBar = "Merging, please wait ..."
Call MergePDFs(MyPath, MyFiles, DestFile)
Application.StatusBar = False
Else
MsgBox "No PDF files found in" & vbLf & MyPath, vbExclamation, "Canceled"
End If
Sheet33.Visible = xlVeryHidden
End Sub
and
Code:
Sub MergePDFs(MyPath As String, MyFiles As String, Optional DestFile As String = "MergedFile.pdf")
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
My problem is that this takes every .pdf in the folder and combines them in the alphabetical order they are in the folder.
I am using Adobe Acrobat X pro, Excel & Word 2016
I am still new to this so any help is appreciated..but it needs to be easy to follow instructions!
Many thanks