troubleshooting Question

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

Avatar of Midhun 123
Midhun 123 asked on
Microsoft OfficeVisual Basic ClassicMicrosoft ExcelVB ScriptVBA
19 Comments1 Solution268 ViewsLast Modified:
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)
    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()
    With sh.Sort
        .SortFields.Add Key:=Rng.Offset(0, 1).Resize(iFil, 1), Order:=xlAscending
        .SetRange Rng.Resize(iFil, 2)
    End With
    If iFil Then a = Application.Transpose(Rng.Resize(iFil, 1))
    Application.DisplayAlerts = False
    Application.DisplayAlerts = True
     ' Merge PDFs
    If iFil Then
        MyFiles = Join(a, ",")
        Application.StatusBar = "Merging, please wait ..."
        Call MergePDFs(MyPath, MyFiles, DestFile)
        Application.StatusBar = False
        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
            Set PartDocs(i) = Nothing
             ' Calc the number of pages in PartDocs(0) document
            n = PartDocs(0).GetNumPages()
        End If
    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
     ' 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
    Set AcroApp = Nothing
End Sub
Join our community to see this answer!
Unlock 1 Answer and 19 Comments.
Start Free Trial
Learn from the best

Network and collaborate with thousands of CTOs, CISOs, and IT Pros rooting for you and your success.

Andrew Hancock - VMware vExpert
See if this solution works for you by signing up for a 7 day free trial.
Unlock 1 Answer and 19 Comments.
Try for 7 days

”The time we save is the biggest benefit of E-E to our team. What could take multiple guys 2 hours or more each to find is accessed in around 15 minutes on Experts Exchange.

-Mike Kapnisakis, Warner Bros