Merging certain .pdf files

[m_in_spain]

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:

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

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

 

[John_w]

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)

Which files should the macro select and in which order? How would the macro know these two criteria?

 

[m_in_spain]

I need it to select a main file, which is a variable name but based upon the folder name, then the DrawingPack.pdf, then three other named files which are in the folder. I can specify the variable named file, which i want to be the first, the drawing pack will always be the second file, the other three are pricesheet.pdf, salt.pdf andRI.pdf (sometimes these last two files are not there though)
Thanks

 

[John_w]

Try this macro. However, without knowing exactly how the main file name is derived from the folder name, I've omitted that file from the list of merged PDFs.

Option Explicit

Public Sub Make_Final_PDF()
    
    Dim pdfFolder As String
    Dim pdfInputFiles As String, pdfFile As Variant
    Dim mergeFiles As String
    Dim pdfOutputFile As String
    
    pdfFolder = "C:\folder\path\PDF_files\"   'CHANGE THIS TO YOUR FOLDER
    If Right(pdfFolder, 1) <> "\" Then pdfFolder = pdfFolder & "\"
    
    pdfInputFiles = "DrawingPack.pdf,pricesheet.pdf,salt.pdf,RI.pdf"
    pdfOutputFile = "Final.pdf"
      
    mergeFiles = ""
    For Each pdfFile In Split(pdfInputFiles, ",")
        If Dir(pdfFolder & pdfFile) <> vbNullString Then mergeFiles = mergeFiles & pdfFile & ","
    Next
    
    If mergeFiles <> "" Then
        Application.StatusBar = "Merging, please wait ..."
        MergePDFs pdfFolder, Left(mergeFiles, Len(mergeFiles) - 1), pdfOutputFile
        Application.StatusBar = False
    Else
        MsgBox "No matching PDF files found in" & vbLf & pdfFolder, vbExclamation, "Make Final PDF"
    End If

End Sub


Private Sub MergePDFs(ByVal pdfFolderPath As String, pdfFilesList As String, Optional pdfDestFile As String = "MergedFile.pdf")

    Dim pdfFiles As Variant, i As Long, numPages As Long, totalPages As Long, p As String
    Dim AcroApp As Acrobat.AcroApp, AcroPDDoc As Acrobat.CAcroPDDoc
    Dim AcroPDDocsMerged As Acrobat.CAcroPDDoc
 
    On Error GoTo exit_
 
    If Right(pdfFolderPath, 1) <> "\" Then pdfFolderPath = pdfFolderPath & "\"
    pdfFiles = Split(pdfFilesList, ",")
 
    Set AcroApp = New Acrobat.AcroApp
    Set AcroPDDocsMerged = New Acrobat.AcroPDDoc
    Set AcroPDDoc = New Acrobat.AcroPDDoc
       
    'Set AcroApp = CreateObject("AcroExch.App")
    'Set AcroPDDocsMerged = CreateObject("AcroExch.PDDoc")
    'Set AcroPDDoc = CreateObject("AcroExch.PDDoc")
        
    If Dir(pdfFolderPath & pdfDestFile) <> vbNullString Then Kill pdfFolderPath & pdfDestFile
    
    AcroPDDocsMerged.Open pdfFolderPath & Trim(pdfFiles(0))
    totalPages = AcroPDDocsMerged.GetNumPages()
    
    For i = 1 To UBound(pdfFiles)
        ' Open PDF document
        AcroPDDoc.Open pdfFolderPath & Trim(pdfFiles(i))
        ' Merge PDF to AcroPDDocsMerged document
        numPages = AcroPDDoc.GetNumPages()
        If Not AcroPDDocsMerged.InsertPages(totalPages - 1, AcroPDDoc, 0, numPages, True) Then
            MsgBox "Cannot insert pages of" & vbLf & pdfFolderPath & pdfFiles(i), vbExclamation, "Merge PDFs"
        End If
        AcroPDDoc.Close
        ' Total number of pages in the merged document
        totalPages = totalPages + numPages
    Next
 
    If i > UBound(pdfFiles) Then
        ' Save the merged document to pdfDestFile
        If AcroPDDocsMerged.Save(PDSaveFull, pdfFolderPath & pdfDestFile) Then
            MsgBox "Created merged PDF:" & vbLf & pdfFolderPath & pdfDestFile, vbInformation, "Merge PDFs"
        Else
            MsgBox "Cannot save the merged PDF" & vbLf & pdfFolderPath & pdfDestFile, vbExclamation, "Merge PDFs"
        End If
    End If
 
exit_:
 
    ' Inform about error
    If Err Then
        MsgBox "Error number: " & Err.Number & vbLf & Err.Description, vbCritical, "Merge PDFs"
    End If
 
    ' Release the memory
    Set AcroPDDoc = Nothing
    If Not AcroPDDocsMerged Is Nothing Then AcroPDDocsMerged.Close
    Set AcroPDDocsMerged = Nothing
 
    ' Quit Acrobat application
    AcroApp.Exit
    Set AcroApp = Nothing
 
End Sub

 

[m_in_spain]

Many thanks for your reply. I have worked out a probably very long winded method of doing this job for myself. Just so I could receive some comments ill post my workaround below, it took 4 seperate subs, one after the other:

Sub CopyFiles()    Sheet33.Visible = xlSheetVisible
    Sheet33.Select
    Dim mypath As String
    Dim mypath2 As String
    Dim MyFiles As String
    Dim Location As String
    Dim myName As String
    Dim fileName As String
    Dim NewName As String
    Dim n As Integer
    Dim p As Integer
    Dim q As Integer
    Dim a() As String, i As Long, f As String
    
    MkDir ActiveWorkbook.path & "\Temp"
    mypath = ActiveWorkbook.path & "\"
    mypath2 = ActiveWorkbook.path & "\Temp"
    
n = 99
p = 0


For q = 1 To 7
n = n + 1
p = p + 1
fileName = Range("AH" & n).Value
NewName = p & ".pdf"
FileCopy mypath & "\" & fileName, mypath2 & "\" & NewName
Next
End Sub

Sub selectFiles()
    Dim path As String
    Dim Location As String
    Dim myName As String
    Dim mypath As String
    Dim File_Folder As String
    Dim Project_Folder As String
    Dim fso As Object
    Set fso = VBA.CreateObject("Scripting.FileSystemObject")
    Dim DataSheet As String
    Sheet33.Select
        'Gets Project name to use for file name
    myName = (Range("AA103").Value)
    Location = myName
    mypath = ActiveWorkbook.path
    
    Project_Folder = mypath & "\Quotes\" & Location & "\"
    File_Folder = Project_Folder & "Temp\"
    Sheet38.Select
    Dim n As Integer
    Dim p As Integer
    n = 3
    p = 1
    For p = 1 To 9
        Range("BP" & n).Select
            If Range("BP" & n) <> "" Then
                DataSheet = File_Folder & "\" & Range("BP" & n).Value & ".pdf"
                Call fso.CopyFile(DataSheet, Project_Folder)
            End If
       n = n + 1
       Next
End Sub

Sub Merge_AllFiles_PDF()
    Dim Doc_Folder As String
    Dim Project_Folder As String
    Dim mainPDF As String
    Dim endpath As String
    Sheet33.Select
    
    
    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
    Dim today As String
    
    myName = (Range("AA103").Value)
    today = Range("AA102").Text
    Location = myName & " Full Quotation " & today & ".pdf"
    Dim DestFile As String
    DestFile = Location
    
    mypath = ActiveWorkbook.path & "\Temp\"
    ' Populate the array a() by PDF file names
    If Right(mypath, 1) <> "\" Then mypath = mypath & "\"
    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
    ' Merge PDFs
    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
   
End Sub

Sub MoveBack()
    Dim mypath As String, MyFiles As String
    Dim a() As String, i As Long, f As String
    Dim path As String
    Dim NewName As String
    Dim myName As String
    Dim folder As Object
    Dim today As String
    today = Range("AA102").Text
    myName = (Range("AA103").Value)
    NewName = myName & " Full Quotation " & today & ".pdf"
    Dim mypath2 As String
    Dim fileName As String
    
    mypath = ActiveWorkbook.path & "\"
    mypath2 = ActiveWorkbook.path & "\Temp"
    fileName = NewName


FileCopy mypath2 & "\" & fileName, mypath & "\" & fileName
Set folder = CreateObject("scripting.filesystemobject")


    folder.deletefolder mypath2, True
End Sub

I dont suppose it is very tidy, but it does work, and by having a go...i am getting there!