0 votes
in VBA by Expert (916 points)
edited by

Hello everyone

I have two folders and in each folder there are a lot of pdf files ...

I am searching for an approach that enables me to merge each two pdf files from both folders if they have the same name ... and put the new merged pdf with the same name to specific directory away from those two folders


In folder1 >> pdf file name "Yasser.pdf"

in folder2 >> pdf file name "Yasser.pdf"

so those two files have to be merged together in a new created directory in the same path of the excel file

 This is my try thill now

Sub Merge_PDF_Files_With_Similar_Names()
    Dim lReceipts, lCases, i As Long, j As Long

    lReceipts = GetFiles(ThisWorkbook.Path & "\Receipts")
    lCases = GetFiles(ThisWorkbook.Path & "\Cases")
    For i = LBound(lReceipts) To UBound(lReceipts)
        For j = LBound(lCases) To UBound(lCases)
            If Split(lReceipts(i), "\")(UBound(Split(lReceipts(i), "\"))) = Split(lCases(j), "\")(UBound(Split(lCases(j), "\"))) Then
                'Debug.Print lReceipts(i), lCases(j)
            End If
        Next j
    Next i
End Sub

Function GetFiles(parentFolder As String) As Variant
    GetFiles = Filter(Split(CreateObject("WScript.Shell").exec("CMD /C DIR """ & parentFolder & IIf(Right(parentFolder, 1) = "\", vbNullString, "\") & "*.*"" /S /B /A:-D").StdOut.ReadAll, vbCrLf), ".")
End Function

Thanks advanced for help

2 Answers

+1 vote
by Super Expert (3.2k points)
selected by
Best answer

I'm glad you solved your question! I love combining skills in applications like this, so I wanted to go ahead and post an alternate working solution here for other folks that might be interested. This solution combines lessons learned from the following tutorials:

Simply update the folder paths in the INITIALIZE VARIABLES section of the LoopAndMerge subroutine and then run it.
Sub LoopAndMerge()
'Looks for PDFs with identical names in two folder.
'If matching names are found in each folder, the PDFs are
' combined and placed in the working directory of the Excel Workbook.
'NOTE: Adobe Acrobat is required (not the reader)
'      - Must add a reference to "Adobe Acrobat X.0 Type Library" or "Acrobat"
'        under Tools > References. This has been tested with Acrobat 6.0 and 10.0.
Dim strFolder1 As String
Dim strFolder2 As String
Dim strFolderFINAL As String
Dim file As Variant
Dim strPDFs(0 To 1) As String
Dim strFileName As String
Dim fso As Object

strFolder1 = "C:\Users\ryanw\Documents\temp\Folder1"
strFolder2 = "C:\Users\ryanw\Documents\temp\Folder2"
strFolderFINAL = ActiveWorkbook.Path
'make sure folders are formatted correctly
If Right(strFolder1, 1) <> "\" Then strFolder1 = strFolder1 & "\"
If Right(strFolder2, 1) <> "\" Then strFolder2 = strFolder2 & "\"
If Right(strFolderFINAL, 1) <> "\" Then strFolderFINAL = strFolderFINAL & "\"

Set fso = CreateObject("Scripting.FileSystemObject")

    file = Dir(strFolder1 & "*.pdf")
    While (file <> "")
        strFileName = CStr(file)
        'loop through each PDF in the folder strFolder1
        ' -The file name is stored as the variable "file"
        ' -The directory + file name can be retrieved with "strFolder1 & file"
        If fso.FileExists(strFolder2 & strFileName) Then
            'PDFs with identical names exist in both folders
            'Merge them and place in strFolderFINAL
            strPDFs(0) = strFolder1 & strFileName
            strPDFs(1) = strFolder2 & strFileName
            Call MergePDFs(strPDFs, strFolderFINAL & file)
        End If
        'do not change below this line in the While loop
        file = Dir
End Sub

Private Function MergePDFs(arrFiles() As String, strSaveAs As String) As Boolean
'---PROGRAM: MergePDFs------------------------------------------------------------------------------
'---DEVELOPER: Ryan Wells (wellsr.com)--------------------------------------------------------------
'---DATE: 09/2017-----------------------------------------------------------------------------------
'---DESCRIPTION: This function uses Adobe Acrobat (won't work with just the Reader!) to-------------
'--- combine PDFs into one PDF and save the new PDF with its own file name.-------------
'---INPUT: The function requires two arguments.-----------------------------------------------------
'--- 1) arrFiles is an array of strings containing the full path to each PDF you want to------
'--- combine in the order you want them combined.------------------------------------------
'--- 2) strSaveAs is a string containing the full path you want to save the new PDF as.-------
'---REQUIREMENTS: 1) Must add a reference to "Adobe Acrobat X.0 Type Library" or "Acrobat"----------
'--- under Tools > References. This has been tested with Acrobat 6.0 and 10.0.------
'---CAUTION: This function won't work unless you have the full Adobe Acrobat. In other words,-------
' Adobe Reader will not work.------------------------------------------------------------
Dim objCAcroPDDocDestination As Acrobat.CAcroPDDoc
Dim objCAcroPDDocSource As Acrobat.CAcroPDDoc
Dim i As Integer
Dim iFailed As Integer
On Error GoTo NoAcrobat:
'Initialize the Acrobat objects
Set objCAcroPDDocDestination = CreateObject("AcroExch.PDDoc")
Set objCAcroPDDocSource = CreateObject("AcroExch.PDDoc")
'Open Destination, all other documents will be added to this and saved with
'a new filename
objCAcroPDDocDestination.Open (arrFiles(LBound(arrFiles))) 'open the first file
'Open each subsequent PDF that you want to add to the original
  'Open the source document that will be added to the destination
    For i = LBound(arrFiles) + 1 To UBound(arrFiles)
        objCAcroPDDocSource.Open (arrFiles(i))
        If objCAcroPDDocDestination.InsertPages(objCAcroPDDocDestination.GetNumPages - 1, objCAcroPDDocSource, 0, objCAcroPDDocSource.GetNumPages, 0) Then
          MergePDFs = True
          'failed to merge one of the PDFs
          iFailed = iFailed + 1
        End If
    Next i
objCAcroPDDocDestination.Save 1, strSaveAs 'Save it as a new name
Set objCAcroPDDocSource = Nothing
Set objCAcroPDDocDestination = Nothing
If iFailed <> 0 Then
    MergePDFs = False
End If
On Error GoTo 0
End Function


by Expert (916 points)
Thank you very much for awesome help Ryan
+1 vote
by Expert (916 points)

I have made use of this great article here


And my issue is solved

Thanks a lot for great forum and awesome tutorials

Keep going on

Welcome to wellsr Q&A
Ask any questions you have about VBA and Python and our community will help answer them. wellsr Q&A is the standalone question and answer platform for wellsr.com. If you have a question about one of our specific tutorials, please include a link back to the tutorial.

Getting Started
VBA Cheat Sheets (On Sale Now)

Looking for something else? Hire our team directly through ourVBA Help page, instead.

For more programming tips visit the VBA Tutorials Blog and the Python Tutorials Blog.