0 votes
in VBA by Expert (892 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 (892 points)
Thank you very much for awesome help Ryan
+1 vote
by Expert (892 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
wellsr Q&A is the VBA and Python programming community that rewards you for learning how to code.

Getting Started
VBA Cheat Sheets (On Sale Now)

Earn free prizes for asking VBA and Python questions and for answering questions asked by others in our community.

Looking for something else? Hire our professional VBA Help, instead.

What makes us different?
Our points system rewards you with a chance for free gifts based on the quality of your questions and answers. All you have to do is post and you could get rewarded, like these members:

ParserMonster $25 Amazon Gift Card
Hightree $10 Amazon Gift Card
Thales1 $10 Amazon Gift Card
runfunke $10 Amazon Gift Card
coolag $10 Amazon Gift Card
Siew Hun $10 Amazon Gift Card

So, why don't you join us? It really is an encouraging way to motivate members in our VBA and Python community.


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