(PDF VBA and Excel) export cover sheet w/ a loop, attach spec sheet from local drive.

[Terriblarius]

Hi there. First post here, hopefully it isn't too much for a first shot. I've queried around and this forum seemed like the best shot at getting closer to finishing my project.

So i have a process that i'm trying to automate. For each project that I do, i'm required to submit a compendium of the devices I have used. Each device spec sheet requires a coversheet. Currently, we generate the cover sheets with microsoft word using mail merge, export the result as a pdf, then we use adobe acrobat to manually hunt and insert the spec sheet to each appropriate coversheet.

So, in going forward with automating, i've retooled the database to what you see below:

database example.jpg

There is a field to determine what devices you want (Merge? column), the information that needs to be displayed on the coversheet, and a hyperlink to the specsheet on the local drive.

On another worksheet, i've made the template for the cover page that forwards each spec sheet. See below.

coversheet example.jpg

At the end of the magic vba loop, this is what is the desired output i want/need.

Desired assembly.jpg

My attempt to code this has been slow and unsuccessful. below is the code i've made so far, But it doesn't do what i need it to and is a long way away from the desired end.

Option Explicit

Sub Merger()

'Cutsheet Combiner
'this macro is an attempt to create a cutsheet cover using a database, and then attach the actual pdf cutsheet from the hyperlink to X drive.

'declare and variables and dimension

Dim i As Integer
Dim y As Integer
Dim x As Integer
Dim z As Integer

Dim pdfcs As Worksheet
Dim pdfnm As String
Dim flnm As String

Dim dir As String



x = Sheet2.Range("D3") 'starting record in database
y = Sheet2.Range("D4") 'final record in database
'z = Sheet2.Range("D2") 'current record row
dir = Sheet1.Range("E1") 'Base directory as formulated in cell E1 in database
pdfnm = "Combined Cutsheets"
flnm = dir & pdfnm
Set pdfcs = Sheets("Coversheet Template")

'loop thru each row in the data base.

For i = x To y

Sheet2.Cells(2, 4).Value = i
'if range("J3") = "y" then export the cover sheet as pdf to an existing pdf
If Sheet2.Range("J3") = "y" Then

'export as pdf cutsheet to a specific file in directory
    pdfcs.ExportAsFixedFormat Type:=xlTypePDF, Filename:=flnm & i - 3, quality:=xlQualityStandard


    'also attach the pdf from the hyperlink at range("J9") specific in directory
    'not sure how to do this
    

End If

'Increment the coversheet database row reference by one


Next i


'end loop

'save fully combined pdf document, not sure how to do this.


End Sub

So that's what i have so far, i'm not married to my existing code and open to tearing it down and starting over. I've also attached the .xlsm workbook a workable example.

Thanks in advance, let me know if this is too much for a first post or if you need more info to help with this.

[Kenneth Hobs]

1. You want to create the cover pdf in Excel rather than MSWord?
2. You want to merge existing pdf files?
a. To merge existing pdf files, you must have a 3rd party application. e.g. Acrobat, not the reader, or PDFCreator v1 or v2, PDFsam, etc. Keep in mind that you users must have this application too. Which did you want to use?
3. Would all of the hyperlinks be based on E2 path?

Tip: When coding, do not use reserved command words for variable names. e.g. Dir().

[Terriblarius]

Hi Kenneth, thanks for responding.

Software i'm currently using:

Excel 2013
Adobe Acrobat 8 pro (since it's free, and allowed me to drag and drop pdfs for doing this project manually.)


1. You want to create the cover pdf in Excel rather than MSWord?
Not mandatory. The original coversheets were being done in MSword via mail merge. I got this idea of generating the coversheet in excel from another site (I can't seem to post the site - so google "mail merge without word john walkenbach" and it'll come up)


2. You want to merge existing pdf files?
Yes. Existing PDF files (as indicated in the hyperlink in Column G) inserted directly behind the generated cover sheet. (see last image).

a. To merge existing pdf files, you must have a 3rd party application. e.g. Acrobat, not the reader, or PDFCreator v1 or v2, PDFsam, etc. Keep in mind that you users must have this application too. Which did you want to use?

I have acrobat 8 installed and working ok so we can go with that. My corporate laptop is not locked down tho so i can use the other software you mentioned if you feel it's better.

3. Would all of the hyperlinks be based on E2 path?
The hyperlinks for each PDF are located in column G. The existing PDFs are on a local drive.

Cell E2 is where i'd like the finished product to be saved to. The finished product being 1 combined pdf of the compiled coversheet+specsheet combos.

Good call not using dir for a variable.

[Kenneth Hobs]

Until I get time to put it all together for you, this should give you an idea.

Private Sub CommandButton1_Click()
  Dim a As Variant
  a = WorksheetFunction.Transpose(Range("A2:A" & Range("A2").End(xlDown).Row).Value)
   MergePDFs Range("C2").Value2, Join(a, ","), Range("B2").Value2
End Sub

Sub MergePDFs(MyPath As String, MyFiles As String, Optional DestFile As String = "MergedFile.pdf")' ZVI:2013-08-27 http://www.vbaexpress.com/forum/showthread.php?47310-Need-code-to-merge-PDF-files-in-a-folder-using-adobe-acrobat-X
' Reference required: VBE - Tools - References - Acrobat
 
    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
 
    ' Adjust MyPath string if needed.
    If Right(MyPath, 1) = "\" Then p = MyPath Else p = MyPath & "\"
    a = Split(MyFiles, ",")
    ReDim PartDocs(0 To UBound(a))
    
    ' Save to MyPath folder if target folder for merged PDF file was not input. (ken)
    If InStr(DestFile, "\") = 0 Then DestFile = p & DestFile
 
    On Error GoTo exit_
    If Len(Dir(DestFile)) Then Kill 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, 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 was created in:" & 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

[Kenneth Hobs]

Add the Acrobat object reference as commented. Change the generic sheet codenames to shtDatabase and shtCover or change the code references.

Sub Main()  
  Dim fn As String, toPath As String, r As Range, c As Range
  Dim v1() As Variant, s1() As String, i As Long, j As Long


  With shtDatabase
    .Calculate 'update E1 and E2 formulas
    If Len(dir(.Range("E1").Value2)) = 0 Then
      MsgBox "Save this workbook and retry.", vbCritical, "Macro Ending"
      Exit Sub
    End If
    
    'Make toPath if needed.
    If Len(dir(.Range("E2").Value2, vbDirectory)) = 0 Then MkDir .Range("E2").Value2
    toPath = .Range("E2").Value2
    
    'Filter column A
    .Range("A3:H3").AutoFilter Field:=1, Criteria1:="y"
    Set r = .Range("A3:H3").CurrentRegion.SpecialCells(xlCellTypeVisible)
    .Range("A3").AutoFilter  'Remove filter.
    If r.Rows.Count = 3 Then Exit Sub 'exit if no filtered data found.
    
    'Make cover pdf file.
    fn = toPath & .Range("B1").Value2 & " - Cover.pdf"
    shtCover.Range("A7:G51").ExportAsFixedFormat xlTypePDF, fn, _
      Quality:=xlQualityStandard, IncludeDocProperties:=True, _
      IgnorePrintAreas:=False, OpenAfterPublish:=False
    
    'Build string array of pdf files to merge.
    j = 0
    Set r = Intersect(r, .Columns("G:G"))
    v1() = RangeTo1dArray(r)
    ReDim s1(0)
    s1(0) = fn  'Cover pdf filename.
    For i = 3 To UBound(v1)
      If Len(dir(v1(i))) > 0 Then
        j = j + 1
        ReDim Preserve s1(0 To j)
        s1(j) = v1(i)
      End If
    Next i
  
    'Set filename for merged pdf file.
    fn = toPath & .Range("B1").Value2 & ".pdf"
  End With
  
  MergePDFs Join(s1, ","), fn
End Sub


Function RangeTo1dArray(aRange As Range) As Variant
  Dim a() As Variant, c As Range, i As Long
  ReDim a(0 To aRange.Cells.Count - 1)
  i = i - 1
  For Each c In aRange
    i = i + 1
    a(i) = c
  Next c
  RangeTo1dArray = a()
End Function


Sub MergePDFs(MyFiles As String, DestFile As String)
     ' 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.CAcroPDDoc
     
    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) = 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 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, 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 was created in:" & 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
    Set AcroApp = Nothing
End Sub

[Terriblarius]

Hi Kenneth, Thanks so much for your work here!

I've added:
Set shtdatabase = Sheets("shtdatabase")
Set shtCover = Sheets("shtcover")

Due to an error i was getting where the "objects were not set". These were added after the dimensioning in sub main()

The result is pretty close. However, it's only creating one cover sheet and then merging all of the pdfs in the folder after it.

I need a cover sheet each spec sheet that is marked to be merged. would this be possible?

the ending result would look like (honda cover sheet - honda specsheet - suzuki cover sheet - suzuki spec sheet - kawasaki cover sheet - kawasaki spec sheet - yamaha cover sheet - yamaha spec sheet)

provided that all of the bikes were selected for merge

I have renamed the excel sheets to match your code. the indirects on the coversheet page were repaired as a result.

It also seems that the script is only drawing up coversheet that is selected in the "Current Preview" value regardless if it's selected or not.

[Kenneth Hobs]

I figured there was more to this than I was seeing.

So what you wanted was to create a two page PDF file I guess. I would also guess that if column A="y" AND the page 2 file exists, then create page 1 (cover) sheet's pdf file and merge with the existing page 2 file.

It is not that difficult. I would still use similar concepts. What I would do though is to change the values of the cells needed for page 1 via a macro loop. I will show you the new Main() but it may need a tweak or two which you should be able to figure out. I will have to make some guesses for cover and merged filenames.

[Kenneth Hobs]

Regarding the sheet codename versus sheetname, codenames are more reliable though I often use sheetnames (names in the tab). e.g.

With WorkSheets("Database")
'or
'Dim shtCodename as Worksheet
'Set shtCodename = Worksheets("Database")
'or just the codename directly as I just posted
'With shtDatabase

Sheets() can be used most times for the sheetname method as well.

I have not tested this but it should be close. It should be easy to see how it works and how to tweak from the comments.

I changed the merge routine a bit to show success in the Immediate window rather than a MsgBox().

Sub Main()
    Dim fn As String, toPath As String, s As String
  Dim r As Range, c As Range, j As Long

  With shtDatabase
    .Calculate 'update E1 and E2 formulas
    If Len(dir(.Range("E1").Value2)) = 0 Then
      MsgBox "Save this workbook and retry.", vbCritical, "Macro Ending"
      Exit Sub
    End If
    
    'Make toPath if needed.
    If Len(dir(.Range("E2").Value2, vbDirectory)) = 0 Then MkDir .Range("E2").Value2
    toPath = .Range("E2").Value2
    
    'Filter column A
    .Range("A3:H3").AutoFilter Field:=1, Criteria1:="y"
    Set r = .Range("A3:H3").CurrentRegion.SpecialCells(xlCellTypeVisible)
    .Range("A3").AutoFilter  'Remove filter.
    If r.Rows.Count = 3 Then Exit Sub 'exit if no filtered data found.
    
    Set r = Intersect(r, .Columns("G:G"))
    For Each c In r
      j = c.Row
      If j < 4 Then GoTo NextC
      
      'Add cover sheet data by filtered rows.
      shtCover.Range("C34").Value2 = .Range("B" & j).Value2 'Device
      shtCover.Range("C38").Value2 = .Range("C" & j).Value2 'Model
      shtCover.Range("C45").Value2 = _
        "Name: " & .Range("D" & j).Value2  'Manufacturer Name
      shtCover.Range("C46").Value2 = _
        .Range("E" & j).Value2 'Website
      
      'Make cover pdf file.
      fn = toPath & .Range("B" & j).Value2 & " - Cover.pdf"
      shtCover.Range("A7:G51").ExportAsFixedFormat xlTypePDF, fn, _
        Quality:=xlQualityStandard, IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, OpenAfterPublish:=False
        
      'Combine cover with existing page 2 pdf.
      s = .Range("G" & j).Value2  'Page 2 filename.
      If Len(dir(s)) = 0 Then GoTo NextC
      s = fn & "," & s  'Comma delimited string for mergepdfs input.
      fn = toPath & .Range("B" & j).Value2 & ".pdf"  'Merged pdf filename.
      Debug.Print s, fn
      'MergePDFs s, fn
NextC:
    Next c
  End With
End Sub


Sub MergePDFs(MyFiles As String, Optional DestFile As String)
     ' 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.CAcroPDDoc
     
    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) = 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 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, 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
        Debug.Print "The resulting file was created in:" & 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
    Set AcroApp = Nothing
End Sub

[Terriblarius]

I have managed to get this project working exactly the way I want it to. I couldn't have done it without your help Kenneth. With some small tweaks to the code you developed and incorporation of more code found in the forum, I have exactly what I want.

Thank you very much Ken! I'll post the end code either tomorrow or Monday.

Happy Halloween ��

[ELANGOVAN]

Hello, i have same problem. But my knowledge on VBA is zero . I have some PDF in folder "SET A" and i have some PDF in folder "SET B" both files in set A and B have same file name. Now i need to merge both files based on same file names and same in another folder say SET C with same file name. I am using Adobe Acrobat XI Pro. Thanks in advance, please help me.

[Kenneth Hobs]

Welcome to the forum! This must be a Halloween need?

I am not sure I know just what you mean. If you mean merge 3 files, maybe:

Sub Main()
  MergePDFs "c:\pdf\SET A\ken.pdf,c:\pdf\SET B\ken.pdf,c:\pdf\SET C\ken.pdf", "c:\temp\ken.pdf"
End Sub

[ELANGOVAN]

Thank you sir, for your response. But requirement is not merging only 3 pdf's. I have 300 pdf's in 2 different folders, and i want to merge pdf files having same name. For example I have 300 Cover sheets(PDF) in Folder"SET A" and the datasheets(PDF) in "SET B". Both folders will have each 300 pdf's which is of same file names. Currently am manually inserting cover pages to each datasheet which has same file names. Now i wanted to automate it, excel should pick of same name from both folder and merge them and save them in a different folder.

Set A folder contains(Cover sheets)
45PCV-16.pdf
54FCV-89.pdf
60LCV-90.pdf

Set B folder contains(Data sheets)
45PCV-16.pdf
54FCV-89.pdf
60LCV-90.pdf

[Kenneth Hobs]

Be sure to add references commented in the code and replace paths in p1, p2, and p3.

'Early Binding method for fso and d requires Reference: MicroSoft Scripting Runtime, scrrun.dll
Sub Main()
  Dim p1 As String, p2 As String, p3 As String, f As String
  Dim d As New Dictionary, e, fso As New FileSystemObject
  Dim a(), b()
  
  '*** Set folder paths to suit ***
  p1 = "C:\Users\lenovo1\Dropbox\Excel\pdf\Acrobat\Sets\Set A\" 'Cover sheet PDFs
  p2 = "C:\Users\lenovo1\Dropbox\Excel\pdf\Acrobat\Sets\Set B\" 'Matching deta PDFs
  p3 = "C:\Users\lenovo1\Dropbox\Excel\pdf\Acrobat\Sets\Set C\ 'Merged PDF folder"


  'Get full pdf filenames in folders.
  a() = aFFs(p1 & "*.pdf")  '& "*.pdf" not needed if only PDFs in p1.
  b() = aFFs(p2 & "*.pdf")
  
  'Create dictionay from b() for easy matching scheme.
  For Each e In b()
    d.Add fso.GetFileName(e), Nothing
  Next e
  
  'Iterate each file in p1, match to p1, and merge to p3 if exists in p2.
  For Each e In a()
    f = fso.GetFileName(e)
    If d.Exists(f) Then MergePDFs e & "," & p2 & f, p3 & f
  Next e
End Sub

'Command line switches for the shell's Dir, http://ss64.com/nt/dir.html
Function aFFs(myDir As String, Optional extraSwitches = "", _
  Optional tfSubFolders As Boolean = False) As Variant
  
  Dim s As String, a() As String, v As Variant
  Dim b() As Variant, i As Long
  
  If tfSubFolders Then
    s = CreateObject("Wscript.Shell").Exec("cmd /c dir " & _
      """" & myDir & """" & " /b /s " & extraSwitches).StdOut.ReadAll
    Else
    s = CreateObject("Wscript.Shell").Exec("cmd /c dir " & _
      """" & myDir & """" & " /b " & extraSwitches).StdOut.ReadAll
  End If
  
  a() = Split(s, vbCrLf)
  If UBound(a) = -1 Then
    MsgBox myDir & " not found.", vbCritical, "Macro Ending"
    Exit Function
  End If
  ReDim Preserve a(0 To UBound(a) - 1) As String 'Trim trailing vblfcr
  
  For i = 0 To UBound(a)
    If Not tfSubFolders Then
      s = Left$(myDir, InStrRev(myDir, "\"))
      'add the folder name
      a(i) = s & a(i)
    End If
  Next i
  aFFs = sA1dtovA1d(a)
End Function


Function sA1dtovA1d(strArray() As String) As Variant
  Dim varArray() As Variant, i As Long
  ReDim varArray(LBound(strArray) To UBound(strArray))
  For i = LBound(strArray) To UBound(strArray)
    varArray(i) = CVar(strArray(i))
  Next i
  sA1dtovA1d = varArray()
End Function


Sub MergePDFs(MyFiles As String, DestFile As String)
     ' 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.CAcroPDDoc
     
    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) = 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 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, 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 was created in:" & 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
    Set AcroApp = Nothing
End Sub

[ELANGOVAN]

HI , First Thanks for your help. I have used your code and i have checked Acrobat reference(Tools-Reference-Acrobat) and i have modified the file path, but i am getting an error (compile error: User-defined type not defined). Should i do anything additional ?

[ELANGOVAN]

'Early Binding method for fso and d requires Reference: MicroSoft Scripting Runtime, scrrun.dllSub Main()
    Dim p1 As String, p2 As String, p3 As String, f As String
    Dim d As New Dictionary, e, fso As New FileSystemObject
    Dim a(), b()
     
     '*** Set folder paths to suit ***
    p1 = "F:\New folder\PDF Merge\SET A\" 'Cover sheet PDFs
    p2 = "F:\New folder\PDF Merge\SET B\" 'Matching deta PDFs
    p3 = "F:\New folder\PDF Merge\SET C\" 'Merged PDF folder'
     
     
     'Get full pdf filenames in folders.
    a() = aFFs(p1 & "*.pdf") '& "*.pdf" not needed if only PDFs in p1.
    b() = aFFs(p2 & "*.pdf")
     
     'Create dictionay from b() for easy matching scheme.
    For Each e In b()
        d.Add fso.GetFileName(e), Nothing
    Next e
     
     'Iterate each file in p1, match to p1, and merge to p3 if exists in p2.
    For Each e In a()
        f = fso.GetFileName(e)
        If d.Exists(f) Then MergePDFs e & "," & p2 & f, p3 & f
    Next e
End Sub
 


Function aFFs(myDir As String, Optional extraSwitches = "", _
    Optional tfSubFolders As Boolean = False) As Variant
     
    Dim s As String, a() As String, v As Variant
    Dim b() As Variant, i As Long
     
    If tfSubFolders Then
        s = CreateObject("Wscript.Shell").Exec("cmd /c dir " & _
        """" & myDir & """" & " /b /s " & extraSwitches).StdOut.ReadAll
    Else
        s = CreateObject("Wscript.Shell").Exec("cmd /c dir " & _
        """" & myDir & """" & " /b " & extraSwitches).StdOut.ReadAll
    End If
     
    a() = Split(s, vbCrLf)
    If UBound(a) = -1 Then
        MsgBox myDir & " not found.", vbCritical, "Macro Ending"
        Exit Function
    End If
    ReDim Preserve a(0 To UBound(a) - 1) As String 'Trim trailing vblfcr
     
    For i = 0 To UBound(a)
        If Not tfSubFolders Then
            s = Left$(myDir, InStrRev(myDir, "\"))
             'add the folder name
            a(i) = s & a(i)
        End If
    Next i
    aFFs = sA1dtovA1d(a)
End Function
 
 
Function sA1dtovA1d(strArray() As String) As Variant
    Dim varArray() As Variant, i As Long
    ReDim varArray(LBound(strArray) To UBound(strArray))
    For i = LBound(strArray) To UBound(strArray)
        varArray(i) = CVar(strArray(i))
    Next i
    sA1dtovA1d = varArray()
End Function
 
 
Sub MergePDFs(MyFiles As String, DestFile As String)
     ' 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.CAcroPDDoc
     
    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) = 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 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, 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 was created in:" & 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
    Set AcroApp = Nothing
End Sub

[Kenneth Hobs]

'Early Binding method for fso and d requires Reference: MicroSoft Scripting Runtime, scrrun.dll

[ELANGOVAN]

Hi sir, Thank you am getting it now. You made my life easy. But i need one more help. I get a pop you for every file "Resulting file is created in so and so folder" instead is it possible to make only 1 pop up after all pdf merged?

[Kenneth Hobs]

I guess you can add your own MsgBox() at the end of Main()?

You can comment out or delete or change MsgBox to Debug.Print in:

MsgBox "The resulting file was created in:" & vbLf & DestFile, vbInformation, "Done"

Debug.Print prints to the Immediate Window in VBE.

For the late vs. early binding issue, see sites like: https://peltiertech.com/Excel/EarlyLateBinding.html
I tend to use more early binding than some since I like to provide more than basic solutions. Itellisense is nice to have for easier coding.