asked on

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

Rgonzo1971

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 123

ASKER

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.

Rgonzo1971

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

Midhun 123

ASKER

No luck..same error is coming

Rgonzo1971

Are the file named like

FileABCRDF.pdf

Rgonzo1971

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 123

ASKER

filenames are Crystal reports-ABCRDF.pdf ,Crystal reports-ABCRDF.pdf .File etc.

Midhun 123

ASKER

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.

Rgonzo1971

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 123

ASKER

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 :-)

Rgonzo1971

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 123

ASKER

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)

Rgonzo1971

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 123

ASKER

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.

Rgonzo1971

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 123

ASKER

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.

ASKER CERTIFIED SOLUTION

Rgonzo1971

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

Midhun 123

ASKER

It worked awesome as per my requirement..Thank you so much

Midhun 123

ASKER

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.