how to differentiate pdf files files in a folder by file name and merge into pdf files based on last modified date using VBA

According to my work,I have a  folder which contains some pdf files.

1.I need to merge files into 2 separate files.(File names ends with ABCRDF & ABCOSD into single merged file and all other pdf files into another merged file.
2.So after merging we will have only 2 pdf files.One which contains file names ends with ABCRDF & ABCOSD.And other merged file with all  files except above 2 files.
3.Merging should be done by last modified time stamp.

I have code which merge all the files present in a folder into a single pdf based last modified time stamp.It wont differentiate files based on file names.It will take all the files present and merge to a single pdf file.I will attach the same here.


Any help regarding this would be greatly appreciated..!! 

Sub Main()

    Const DestFile As String = "MergedFile.pdf"
    
    Dim MyPath As String, MyFiles As String
    Dim a As Variant, i As Long, f As String
     
     ' Choose the folder or just replace that part by: MyPath = Range("E3")
    With Application.FileDialog(msoFileDialogFolderPicker)
         '.InitialFileName = "C:\Temp\"
        .AllowMultiSelect = False
        If .Show = False Then Exit Sub
        MyPath = .SelectedItems(1)
        DoEvents
    End With
     
     ' Populate the array a() by PDF file names
    If Right(MyPath, 1) <> "\" Then MyPath = MyPath & "\"
    Set sh = Workbooks.Add.Sheets(1)
    Set Rng = sh.Range("A1") ' or wherever; doesn't matter

    Set fso = CreateObject("Scripting.FileSystemObject")

    f = Dir(MyPath & "*.pdf")
    While Len(f)
        iFil = iFil + 1
        Set fsofile = fso.getfile(MyPath & f)
        With Rng.Cells(iFil, 1)
            .Value = fsofile.Name
            .Offset(0, 1).Value = fsofile.DateLastModified
        End With
        f = Dir()
    Wend
    With sh.Sort
        .SortFields.Add Key:=Rng.Offset(0, 1).Resize(iFil, 1), Order:=xlAscending
        .SetRange Rng.Resize(iFil, 2)
        .Apply
    End With
    If iFil Then a = Application.Transpose(Rng.Resize(iFil, 1))
    Application.DisplayAlerts = False
    sh.Delete
    Application.DisplayAlerts = True
    
     ' Merge PDFs
    If iFil Then
        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 MergePDFs(MyPath As String, MyFiles As String, Optional DestFile As String = "MergedFile.pdf")
     
     ' 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
     
    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

Open in new window

Midhun 123Application developerAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Rgonzo1971Commented:
Hi,

Pls try 
Sub Main()

    Const DestFile As String = "MergedFile.pdf"
    
    Dim MyPath As String, MyFiles As String
    Dim a As Variant, i As Long, f As String
     
     ' Choose the folder or just replace that part by: MyPath = Range("E3")
    With Application.FileDialog(msoFileDialogFolderPicker)
         '.InitialFileName = "C:\Temp\"
        .AllowMultiSelect = False
        If .Show = False Then Exit Sub
        MyPath = .SelectedItems(1)
        DoEvents
    End With
     
     ' Populate the array a() by PDF file names
    If Right(MyPath, 1) <> "\" Then MyPath = MyPath & "\"
    Set sh = Workbooks.Add.Sheets(1)
    Set Rng = sh.Range("A1") ' or wherever; doesn't matter

    Set fso = CreateObject("Scripting.FileSystemObject")
    For Each Item In Array("ABCRDF", "ABCOSD")
        f = Dir(MyPath & "*" & Item & ".pdf")
        While Len(f)
            iFil = iFil + 1
            Set fsofile = fso.getfile(MyPath & f)
            With Rng.Cells(iFil, 1)
                .Value = fsofile.Name
                .Offset(0, 1).Value = fsofile.DateLastModified
            End With
            f = Dir()
        Wend
        With sh.Sort
            .SortFields.Add Key:=Rng.Offset(0, 1).Resize(iFil, 1), Order:=xlAscending
            .SetRange Rng.Resize(iFil, 2)
            .Apply
        End With
        If iFil Then a = Application.Transpose(Rng.Resize(iFil, 1))
        Application.DisplayAlerts = False
        sh.Delete
        Application.DisplayAlerts = True
        
         ' Merge PDFs
        If iFil Then
            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
    Next
End Sub
     
Sub MergePDFs(MyPath As String, MyFiles As String, Optional DestFile As String = "MergedFile.pdf")
     
     ' 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
     
    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

Open in new window

Regards
Midhun 123Application developerAuthor Commented:
Thank you for your response.

Actually both merged file names should be different for both files..In above only one dest file name is mentioned..Could you please help me on that also.

I am getting the below error while running the above code.

error4.jpgerror5.jpg
Rgonzo1971Commented:
then try
Sub Main()

    Const DestFile As String = "MergedFile"
    
    Dim MyPath As String, MyFiles As String
    Dim a As Variant, i As Long, f As String
    Dim FileIdx
    FileIdx = 1
     ' Choose the folder or just replace that part by: MyPath = Range("E3")
    With Application.FileDialog(msoFileDialogFolderPicker)
         '.InitialFileName = "C:\Temp\"
        .AllowMultiSelect = False
        If .Show = False Then Exit Sub
        MyPath = .SelectedItems(1)
        DoEvents
    End With
     
     ' Populate the array a() by PDF file names
    If Right(MyPath, 1) <> "\" Then MyPath = MyPath & "\"
    Set sh = Workbooks.Add.Sheets(1)
    Set Rng = sh.Range("A1") ' or wherever; doesn't matter

    Set fso = CreateObject("Scripting.FileSystemObject")
    For Each Item In Array("ABCRDF", "ABCOSD")
        iFil = 0
        f = Dir(MyPath & "*" & Item & ".pdf")
        While Len(f)
            iFil = iFil + 1
            Set fsofile = fso.getfile(MyPath & f)
            With Rng.Cells(iFil, 1)
                .Value = fsofile.Name
                .Offset(0, 1).Value = fsofile.DateLastModified
            End With
            f = Dir()
        Wend
        With sh.Sort
            .SortFields.Add Key:=Rng.Offset(0, 1).Resize(iFil, 1), Order:=xlAscending
            .SetRange Rng.Resize(iFil, 2)
            .Apply
        End With
        If iFil Then a = Application.Transpose(Rng.Resize(iFil, 1))
        Application.DisplayAlerts = False
        sh.Delete
        Application.DisplayAlerts = True
        
         ' Merge PDFs
        If iFil Then
            MyFiles = Join(a, ",")
            Application.StatusBar = "Merging, please wait ..."
            Call MergePDFs(MyPath, MyFiles, DestFile & FileIdx & ".pdf")
            Application.StatusBar = False
        Else
            MsgBox "No PDF files found in" & vbLf & MyPath, vbExclamation, "Canceled"
        End If
    Next
End Sub
     
Sub MergePDFs(MyPath As String, MyFiles As String, Optional DestFile As String = "MergedFile.pdf")
     
     ' 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
     
    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

Open in new window

Price Your IT Services for Profit

Managed service contracts are great - when they're making you money. Yes, you’re getting paid monthly, but is it actually profitable? Learn to calculate your hourly overhead burden so you can master your IT services pricing strategy.

Download eBook
Midhun 123Application developerAuthor Commented:
No luck..same  error is coming
Rgonzo1971Commented:
Are the file named like

 FileABCRDF.pdf
Rgonzo1971Commented:
then try 
Sub Main()

    Const DestFile As String = "MergedFile"
    
    Dim MyPath As String, MyFiles As String
    Dim a As Variant, i As Long, f As String
    Dim FileIdx
     
     ' Choose the folder or just replace that part by: MyPath = Range("E3")
    With Application.FileDialog(msoFileDialogFolderPicker)
         '.InitialFileName = "C:\Temp\"
        .AllowMultiSelect = False
        If .Show = False Then Exit Sub
        MyPath = .SelectedItems(1)
        DoEvents
    End With
     
     ' Populate the array a() by PDF file names
    If Right(MyPath, 1) <> "\" Then MyPath = MyPath & "\"
    Set sh = Workbooks.Add.Sheets(1)
    Set Rng = sh.Range("A1") ' or wherever; doesn't matter

    Set fso = CreateObject("Scripting.FileSystemObject")
    For Each Item In Array("ABCRDF", "ABCOSD")
        f = Dir(MyPath & "*" & Item & ".pdf")
        While Len(f)
            iFil = iFil + 1
            Set fsofile = fso.getfile(MyPath & f)
            With Rng.Cells(iFil, 1)
                .Value = fsofile.Name
                .Offset(0, 1).Value = fsofile.DateLastModified
            End With
            f = Dir()
        Wend
        If iFil Then
            With sh.Sort
                .SortFields.Add Key:=Rng.Offset(0, 1).Resize(iFil, 1), Order:=xlAscending
                .SetRange Rng.Resize(iFil, 2)
                .Apply
            End With
            a = Application.Transpose(Rng.Resize(1, 1))
        End If
        Application.DisplayAlerts = False
        sh.Delete
        Application.DisplayAlerts = True
        
         ' Merge PDFs
        If iFil Then
            If iFil = 1 Then
                MyFiles = a
            Else
                MyFiles = Join(a, ",")
            End If
            Application.StatusBar = "Merging, please wait ..."
            FileIdx = FileIdx + 1
            Call MergePDFs(MyPath, MyFiles, DestFile & FileIdx & ".pdf")
            Application.StatusBar = False
        Else
            MsgBox "No PDF files found in" & vbLf & MyPath, vbExclamation, "Canceled"
        End If
    Next
End Sub
     
Sub MergePDFs(MyPath As String, MyFiles As String, Optional DestFile As String = "MergedFile.pdf")
     
     ' 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
     
    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

Open in new window

Midhun 123Application developerAuthor Commented:
filenames are Crystal reports-ABCRDF.pdf ,Crystal reports-ABCRDF.pdf .File etc.
Midhun 123Application developerAuthor Commented:
I  tried with above code..now one resulted file is created name as mergedfile1.pdf  which contains only one file which has high last modified timestamp among all  ABCRDF and ABCOSD files.And the second resulted file is not get created also.

Ideally It should includes all the files which ends with ABCRDF and ABCOSD.But while running this code , now it is taking only one file (Which got created first )  among all the ABCRDF and ABCOSD files.

I am attaching the error also.

error9.jpgerrror8.jpg
Rgonzo1971Commented:
then try
Sub Main()

    Const DestFile As String = "MergedFile"
    
    Dim MyPath As String, MyFiles As String
    Dim a As Variant, i As Long, f As String
    Dim FileIdx
     
     ' Choose the folder or just replace that part by: MyPath = Range("E3")
    With Application.FileDialog(msoFileDialogFolderPicker)
         '.InitialFileName = "C:\Temp\"
        .AllowMultiSelect = False
        If .Show = False Then Exit Sub
        MyPath = .SelectedItems(1)
        DoEvents
    End With
     
     ' Populate the array a() by PDF file names
    If Right(MyPath, 1) <> "\" Then MyPath = MyPath & "\"
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    For Each Item In Array("ABCRDF", "ABCOSD")

        Set sh = Workbooks.Add.Sheets(1)
        Set Rng = sh.Range("A1") ' or wherever; doesn't matter

        f = Dir(MyPath & "*" & Item & ".pdf")
        While Len(f)
            iFil = iFil + 1
            Set fsofile = fso.getfile(MyPath & f)
            With Rng.Cells(iFil, 1)
                .Value = fsofile.Name
                .Offset(0, 1).Value = fsofile.DateLastModified
            End With
            f = Dir()
        Wend
        If iFil Then
            With sh.Sort
                .SortFields.Add Key:=Rng.Offset(0, 1).Resize(iFil, 1), Order:=xlAscending
                .SetRange Rng.Resize(iFil, 2)
                .Apply
            End With
            a = Application.Transpose(Rng.Resize(iFil, 1))
        End If
        Application.DisplayAlerts = False
        sh.Delete
        Application.DisplayAlerts = True
        
         ' Merge PDFs
        If iFil Then
            If iFil = 1 Then
                MyFiles = a
            Else
                MyFiles = Join(a, ",")
            End If
            Application.StatusBar = "Merging, please wait ..."
            FileIdx = FileIdx + 1
            Call MergePDFs(MyPath, MyFiles, DestFile & FileIdx & ".pdf")
            Application.StatusBar = False
        Else
            MsgBox "No PDF files found in" & vbLf & MyPath, vbExclamation, "Canceled"
        End If
    Next
End Sub

Open in new window

EDITED Corrected
Midhun 123Application developerAuthor Commented:
Hi ,

Sorry for the late reply.

2 output files are getting created named as mergedFile1 and mergedFile2. But first merged file contains only one file,  filename ends with ABCRDF(it's LastModifiedTime is most recent among all  ABCRDF and ABCOSD files). Next output file contains again only one  file which is having second least LastModifiedTime among all ABCRDF and ABCOSD files.Rest of the input files are not getting added to any of these 2 output files.

While running above code, First output file(MergedFile1)  got created as explained above and after that dialogue box appeared saying " Cannot Insert pages of input folder path" .Then next output file(MergedFile2) got created.

Any help regarding this would be appreciated  :-)
Rgonzo1971Commented:
then try
Sub Main()

    Const DestFile As String = "MergedFile"
    
    Dim MyPath As String, MyFiles As String
    Dim a As Variant, i As Long, f As String
    Dim FileIdx
     
     ' Choose the folder or just replace that part by: MyPath = Range("E3")
    With Application.FileDialog(msoFileDialogFolderPicker)
         '.InitialFileName = "C:\Temp\"
        .AllowMultiSelect = False
        If .Show = False Then Exit Sub
        MyPath = .SelectedItems(1)
        DoEvents
    End With
     
     ' Populate the array a() by PDF file names
    If Right(MyPath, 1) <> "\" Then MyPath = MyPath & "\"
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    For Each Item In Array("ABCRDF", "ABCOSD")

        Set sh = Workbooks.Add.Sheets(1)
        Set Rng = sh.Range("A1") ' or wherever; doesn't matter
        iFil = 0
        f = Dir(MyPath & "*" & Item & ".pdf")
        While Len(f)
            iFil = iFil + 1
            Set fsofile = fso.getfile(MyPath & f)
            With Rng.Cells(iFil, 1)
                .Value = fsofile.Name
                .Offset(0, 1).Value = fsofile.DateLastModified
            End With
            f = Dir()
        Wend
        If iFil Then
            With sh.Sort
                .SortFields.Add Key:=Rng.Offset(0, 1).Resize(iFil, 1), Order:=xlAscending
                .SetRange Rng.Resize(iFil, 2)
                .Apply
            End With
            a = Application.Transpose(Rng.Resize(iFil, 1))
        End If
        Application.DisplayAlerts = False
        sh.Delete
        Application.DisplayAlerts = True
        
         ' Merge PDFs
        If iFil Then
            If iFil = 1 Then
                MyFiles = a
            Else
                MyFiles = Join(a, ",")
            End If
            Application.StatusBar = "Merging, please wait ..."
            FileIdx = FileIdx + 1
            Call MergePDFs(MyPath, MyFiles, DestFile & FileIdx & ".pdf")
            Application.StatusBar = False
        Else
            MsgBox "No PDF files found in" & vbLf & MyPath, vbExclamation, "Canceled"
        End If
    Next
End Sub

Open in new window

on which file is the " Cannot Insert pages of input folder path" error
Midhun 123Application developerAuthor Commented:
Hi,

Thanks for your assistance.

I tried with above code.Every files with ABCRDF file name combined and merged into one file and all files with ABCOSD merged into other file.

But our requirement is filename ends with both ABCRDF and ABCOSD should combine and merge into single file(MergedFile1).Rest of the files should combine into other output file(MergedFile2)
Rgonzo1971Commented:
then try 
Sub Main()

    Const DestFile As String = "MergedFile"
    
    Dim MyPath As String, MyFiles As String
    Dim a As Variant, i As Long, f As String
    Dim FileIdx
     
     ' Choose the folder or just replace that part by: MyPath = Range("E3")
    With Application.FileDialog(msoFileDialogFolderPicker)
         '.InitialFileName = "C:\Temp\"
        .AllowMultiSelect = False
        If .Show = False Then Exit Sub
        MyPath = .SelectedItems(1)
        DoEvents
    End With
     
     ' Populate the array a() by PDF file names
    If Right(MyPath, 1) <> "\" Then MyPath = MyPath & "\"
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set sh = Workbooks.Add.Sheets(1)
    Set Rng = sh.Range("A" & Rows.Count).End(xlUp).Offset(1) ' or wherever; doesn't matter
    For Each Item In Array("1", ")")
        f = Dir(MyPath & "*" & Item & ".pdf")
        While Len(f)
            iFil = iFil + 1
            Set fsofile = fso.getfile(MyPath & f)
            With Rng.Cells(iFil, 1)
                .Value = fsofile.Name
                .Offset(0, 1).Value = fsofile.DateLastModified
            End With
            f = Dir()
        Wend
    Next
    If iFil Then
        With sh.Sort
            .SortFields.Add Key:=Rng.Offset(0, 1).Resize(iFil, 1), Order:=xlAscending
            .SetRange Rng.Resize(iFil, 2)
            .Apply
        End With
        a = Application.Transpose(Rng.Resize(iFil, 1))
    End If
    Application.DisplayAlerts = False
    sh.Delete
    Application.DisplayAlerts = True
'   Merge PDFs
    If iFil Then
        If iFil = 1 Then
              MyFiles = a
        Else
            MyFiles = Join(a, ",")
        End If
        Application.StatusBar = "Merging, please wait ..."
        FileIdx = FileIdx + 1
        Call MergePDFs(MyPath, MyFiles, DestFile & FileIdx & ".pdf")
        Application.StatusBar = False
    End If

    iFil = 0
    Set sh = Workbooks.Add.Sheets(1)
    Set Rng = sh.Range("A1") ' or wherever; doesn't matter

    f = Dir(MyPath & "*.pdf")
    While Len(f)
        mtch = Application.Match(f, a, 0)
        If IsError(mtch) Then
            iFil = iFil + 1
            Set fsofile = fso.getfile(MyPath & f)
            With Rng.Cells(iFil, 1)
                .Value = fsofile.Name
                .Offset(0, 1).Value = fsofile.DateLastModified
            End With
        End If
        f = Dir()
    Wend
    If iFil Then
        With sh.Sort
            .SortFields.Add Key:=Rng.Offset(0, 1).Resize(iFil, 1), Order:=xlAscending
            .SetRange Rng.Resize(iFil, 2)
            .Apply
        End With
        a1 = Application.Transpose(Rng.Resize(iFil, 1))
    End If
    Application.DisplayAlerts = False
    sh.Delete
    Application.DisplayAlerts = True
     ' Merge PDFs
    If iFil Then
        If iFil = 1 Then
            MyFiles = a1
        Else
            MyFiles = Join(a1, ",")
        End If
        Application.StatusBar = "Merging, please wait ..."
        FileIdx = FileIdx + 1
        Call MergePDFs(MyPath, MyFiles, DestFile & FileIdx & ".pdf")
        Application.StatusBar = False
    Else
        MsgBox "No PDF files found in" & vbLf & MyPath, vbExclamation, "Canceled"
    End If

End Sub

Open in new window

Midhun 123Application developerAuthor Commented:
Now every file present in the folder is getting combined and merged into 2nd output file(MergedFile2). When debugging,I noticed ,for creating 2nd output file,it is taking MergedFile1 too(because it is getting created already and present in the same path).

1st  Output file contain both files ends with ABCRDF and ABCOSD plus some more files present in the folder.
Rgonzo1971Commented:
then try
Sub Main()

    Const DestFile As String = "MergedFile"
    
    Dim MyPath As String, MyFiles As String
    Dim a As Variant, i As Long, f As String
    Dim FileIdx
     
     ' Choose the folder or just replace that part by: MyPath = Range("E3")
    With Application.FileDialog(msoFileDialogFolderPicker)
         '.InitialFileName = "C:\Temp\"
        .AllowMultiSelect = False
        If .Show = False Then Exit Sub
        MyPath = .SelectedItems(1)
        DoEvents
    End With
     
     ' Populate the array a() by PDF file names
    If Right(MyPath, 1) <> "\" Then MyPath = MyPath & "\"
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set sh = Workbooks.Add.Sheets(1)
    Set Rng = sh.Range("A" & Rows.Count).End(xlUp).Offset(1) ' or wherever; doesn't matter
    For Each Item In Array("ABCRDF", "ABCOSD")
        f = Dir(MyPath & "*" & Item & ".pdf")
        While Len(f)
            iFil = iFil + 1
            Set fsofile = fso.getfile(MyPath & f)
            With Rng.Cells(iFil, 1)
                .Value = fsofile.Name
                .Offset(0, 1).Value = fsofile.DateLastModified
            End With
            f = Dir()
        Wend
    Next
    If iFil Then
        With sh.Sort
            .SortFields.Add Key:=Rng.Offset(0, 1).Resize(iFil, 1), Order:=xlAscending
            .SetRange Rng.Resize(iFil, 2)
            .Apply
        End With
        a = Application.Transpose(Rng.Resize(iFil, 1))
    End If
    Application.DisplayAlerts = False
    sh.Delete
    Application.DisplayAlerts = True
'   Merge PDFs
    If iFil Then
        If iFil = 1 Then
              MyFiles = a
        Else
            MyFiles = Join(a, ",")
        End If
        Application.StatusBar = "Merging, please wait ..."
        FileIdx = FileIdx + 1
        Call MergePDFs(MyPath, MyFiles, DestFile & FileIdx & ".pdf")
        Application.StatusBar = False
    End If

    iFil = 0
    Set sh = Workbooks.Add.Sheets(1)
    Set Rng = sh.Range("A1") ' or wherever; doesn't matter

    f = Dir(MyPath & "*.pdf")
    While Len(f)
        mtch = Application.Match(f, a, 0)
        If IsError(mtch) Then
            iFil = iFil + 1
            Set fsofile = fso.getfile(MyPath & f)
            With Rng.Cells(iFil, 1)
                .Value = fsofile.Name
                .Offset(0, 1).Value = fsofile.DateLastModified
            End With
        End If
        f = Dir()
    Wend
    If iFil Then
        With sh.Sort
            .SortFields.Add Key:=Rng.Offset(0, 1).Resize(iFil, 1), Order:=xlAscending
            .SetRange Rng.Resize(iFil, 2)
            .Apply
        End With
        a1 = Application.Transpose(Rng.Resize(iFil, 1))
    End If
    Application.DisplayAlerts = False
    sh.Delete
    Application.DisplayAlerts = True
     ' Merge PDFs
    If iFil Then
        If iFil = 1 Then
            MyFiles = a1
        Else
            MyFiles = Join(a1, ",")
        End If
        Application.StatusBar = "Merging, please wait ..."
        FileIdx = FileIdx + 1
        Call MergePDFs(MyPath, MyFiles, DestFile & FileIdx & ".pdf")
        Application.StatusBar = False
    Else
        MsgBox "No PDF files found in" & vbLf & MyPath, vbExclamation, "Canceled"
    End If

End Sub

Open in new window

Midhun 123Application developerAuthor Commented:
Hello All,

Good day...

I tried with above code..

1.Now output file 1(MergedFile1) contains all the files ends with ABCRDF and ABCOSD as expected.
2.But Merged file2 contains all the files present in the folder..While merging files,It is taking MergedFile1 also..As per our requirement,It should not take MergedFile1.
Rgonzo1971Commented:
then try 
Sub Main()

    Const DestFile As String = "MergedFile"
    
    Dim MyPath As String, MyFiles As String
    Dim a As Variant, i As Long, f As String
    Dim FileIdx
     
     ' Choose the folder or just replace that part by: MyPath = Range("E3")
    With Application.FileDialog(msoFileDialogFolderPicker)
         '.InitialFileName = "C:\Temp\"
        .AllowMultiSelect = False
        If .Show = False Then Exit Sub
        MyPath = .SelectedItems(1)
        DoEvents
    End With
     
     ' Populate the array a() by PDF file names
    If Right(MyPath, 1) <> "\" Then MyPath = MyPath & "\"
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set sh = Workbooks.Add.Sheets(1)
    Set Rng = sh.Range("A" & Rows.Count).End(xlUp).Offset(1) ' or wherever; doesn't matter
    For Each Item In Array("ABCRDF", "ABCOSD")
        f = Dir(MyPath & "*" & Item & ".pdf")
        While Len(f)
            iFil = iFil + 1
            Set fsofile = fso.getfile(MyPath & f)
            With Rng.Cells(iFil, 1)
                .Value = fsofile.Name
                .Offset(0, 1).Value = fsofile.DateLastModified
            End With
            f = Dir()
        Wend
    Next
    If iFil Then
        With sh.Sort
            .SortFields.Add Key:=Rng.Offset(0, 1).Resize(iFil, 1), Order:=xlAscending
            .SetRange Rng.Resize(iFil, 2)
            .Apply
        End With
        a = Application.Transpose(Rng.Resize(iFil, 1))
    End If
    Application.DisplayAlerts = False
    sh.Delete
    Application.DisplayAlerts = True
'   Merge PDFs
    If iFil Then
        If iFil = 1 Then
              MyFiles = a
        Else
            MyFiles = Join(a, ",")
        End If
        Application.StatusBar = "Merging, please wait ..."
        FileIdx = FileIdx + 1
        Call MergePDFs(MyPath, MyFiles, DestFile & FileIdx & ".pdf")
        Application.StatusBar = False
    End If

    iFil = 0
    Set sh = Workbooks.Add.Sheets(1)
    Set Rng = sh.Range("A1") ' or wherever; doesn't matter

    f = Dir(MyPath & "*.pdf")
    While Len(f)
        
        mtch = Application.Match(f, a, 0)
        If IsError(mtch) Then
        If Not f Like "MergedFile*.pdf" Then
            iFil = iFil + 1
            Set fsofile = fso.getfile(MyPath & f)
            With Rng.Cells(iFil, 1)
                .Value = fsofile.Name
                .Offset(0, 1).Value = fsofile.DateLastModified
            End With
        End If
        End If
        f = Dir()
    Wend
    If iFil Then
        With sh.Sort
            .SortFields.Add Key:=Rng.Offset(0, 1).Resize(iFil, 1), Order:=xlAscending
            .SetRange Rng.Resize(iFil, 2)
            .Apply
        End With
        a1 = Application.Transpose(Rng.Resize(iFil, 1))
    End If
    Application.DisplayAlerts = False
    sh.Delete
    Application.DisplayAlerts = True
     ' Merge PDFs
    If iFil Then
        If iFil = 1 Then
            MyFiles = a1
        Else
            MyFiles = Join(a1, ",")
        End If
        Application.StatusBar = "Merging, please wait ..."
        FileIdx = FileIdx + 1
        Call MergePDFs(MyPath, MyFiles, DestFile & FileIdx & ".pdf")
        Application.StatusBar = False
    Else
        MsgBox "No PDF files found in" & vbLf & MyPath, vbExclamation, "Canceled"
    End If

End Sub

Open in new window

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Midhun 123Application developerAuthor Commented:
It worked awesome as per my requirement..Thank you so much
Midhun 123Application developerAuthor Commented:
Thank You so much...

Thanks alot for your valuable time and assistance.

It worked awesome...Working fine as expected..

2 output files got created as per my requirement.
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
VB Script

From novice to tech pro — start learning today.