VB code Get 2 latest file names from Directory

Hello Riz,

The Check Boxes use a single macro to return the two most recently created files. This can be changed to the date last modified or accessed. When the Check Box is true it will return the tiles names.

The location of the folder and the file names are dependent on the upper left corner of the Check Box. I have made sure that your Check Boxes are in cells $I$1 and $I$2. If you add any more, please be sure the upper left corner of the drag-drop outline is in cell $I$3 etc.

Module3 Macro Code

Option Explicit

Function GetFileDates(ByVal Folderpath As Variant, Optional ByVal Descending As Boolean) As Variant

    Dim fDate   As Variant
    Dim fDates  As Variant
    Dim File    As Object
    Dim Files   As Object
    Dim Folder  As Variant
    Dim LB      As Long
    Dim j       As Long
    Dim n       As Long
    Dim Newest  As Date
    Dim Sorted  As Boolean
    Dim tmpDate As Variant
    Dim UB      As Long
    
    
        With CreateObject("Shell.Application")
            Set Folder = .Namespace(Folderpath)
            If Folder Is Nothing Then Exit Function
        End With
            
            Set Files = Folder.Items
                
            Files.Filter 64, "*.*"
                
            ReDim fDates(0 To Files.Count - 1)
            
          ' Save the file name and the data in fDates.
            For Each File In Files
              ' 3 = Date Modified, 4 = Date Created, 5 = Date Last Accessed
                fDates(n) = Array(File.Name, CDate(Folder.GetDetailsOf(File, 4)))
                n = n + 1
            Next File
            
          ' Sort the files by date using a modified bubble sort.
            LB = LBound(fDates, 1)
            UB = UBound(fDates, 1)
        
            Do
                Sorted = True
                
                For j = LB To UB - 1
                    If Descending Xor (fDates(j)(1) > fDates(j + 1)(1)) Then
                        tmpDate = fDates(j + 1)
                        fDates(j + 1) = fDates(j)
                        fDates(j) = tmpDate
                        Sorted = False
                    End If
                Next j
                
                UB = UB - 1
            Loop Until Sorted Or UB < 1
            
      ' Convert fDates into a 1 based 2-D array.
        fDates = Application.Transpose(fDates)
        GetFileDates = Application.Transpose(fDates)
        
End Function

Sub Macro1()

    Dim ChkBox  As Object
    Dim fDates  As Variant
    Dim Rng     As Range
    
        Set ChkBox = ActiveSheet.Shapes(Application.Caller)
        
        Set Rng = ChkBox.TopLeftCell
        
        If ChkBox.ControlFormat.Value = xlOn Then
            fDates = GetFileDates(Rng.Offset(0, 2).Value, True)
            If Not IsEmpty(fDates) Then
                Rng.Offset(0, 3).Resize(1, 2).Value = Array(fDates(1, 1), fDates(2, 1))
            End If
        End If
        
End Sub

Hello Riz,

Happy New Year! I thought you might want to do that. This workbook has that change added. A few other changes were also made to speed up the sorting of the files by date.

Let me know if you have any issues with this version.

Revised Macro Code for Module3

Option Explicit

Function GetFileDates(ByVal Folderpath As Variant, Optional ByVal Descending As Boolean) As Variant

    Dim fDate   As Variant
    Dim fDates  As Variant
    Dim File    As Object
    Dim Files   As Object
    Dim Folder  As Variant
    Dim LB      As Long
    Dim j       As Long
    Dim n       As Long
    Dim Newest  As Date
    Dim Sorted  As Boolean
    Dim tmpDate As Variant
    Dim UB      As Long
    
    
        With CreateObject("Shell.Application")
            Set Folder = .Namespace(Folderpath)
            If Folder Is Nothing Then Exit Function
        End With
            
            Set Files = Folder.Items
                
            Files.Filter 64, "*.*"
                
            ReDim fDates(Files.Count - 1, 1)
            
          ' Save the file name and the data in fDates.
            For Each File In Files
              ' 3 = Date Modified, 4 = Date Created, 5 = Date Last Accessed
                fDates(n, 0) = File.Name
                fDates(n, 1) = CDate(Folder.GetDetailsOf(File, 4))
                n = n + 1
            Next File
            
          ' Sort the files by date using a modified bubble sort.
            LB = LBound(fDates, 1)
            UB = UBound(fDates, 1)
            
            Do
                n = 0
                
                For j = LB To UB - 1
                    If Descending Xor (fDates(j, 0) > fDates(j + 1, 0)) Then
                        tmpDate = fDates(j + 1, 0)
                        fDates(j + 1, 0) = fDates(j, 0)
                        fDates(j, 0) = tmpDate
                        
                        tmpDate = fDates(j + 1, 1)
                        fDates(j + 1, 1) = fDates(j, 1)
                        fDates(j, 1) = tmpDate
                        
                        n = j
                    End If
                Next j
                
                UB = n
                
            Loop Until UB = 0
            
        GetFileDates = fDates
        
End Function

Sub Macro1()

    Dim ChkBox  As Object
    Dim fDates  As Variant
    Dim Rng     As Range
    
        Set ChkBox = ActiveSheet.Shapes(Application.Caller)
        
        Set Rng = ChkBox.TopLeftCell
        
        If ChkBox.ControlFormat.Value = xlOn Then
            fDates = GetFileDates(Rng.Offset(0, 2).Value, True)
            If Not IsEmpty(fDates) Then
                Rng.Offset(0, 3).Resize(1, 2).Value = Array(fDates(0, 0), fDates(1, 0))
            End If
        Else
            Rng.Offset(0, 3).Resize(1, 2).Value = Empty
        End If
        
End Sub

Hi Apo:
This is what happens.
When i click on check box, it gives Runtime error, Subscript out of range.
When I debug with F8, It highlights at

 [L1] = Z(0)

Once again sorry for late response as I was travelling.

Riz

Hello Riz,

Your last post is substantial different from the example you posted originally. If you have an updated sample workbook you should post it.

Will only one folder be searched or several? If several folders are to be searched please include the paths or were the paths can be found.

Hello Riz,

Thanks for the updated workbook.

If I understands this, the file name is in A15 and if the check box is checked then the macro will search the folder path using cells in columns "K1:L6"

What information is to be copied into the cells in columns "M1:N6"?

Hello Riz,

Sorry for the late reply. There we several emergencies I had to deal with after my last post.

Here is the new workbook and code. Test it out and let me know if this what you need.

' Thread:   http://www.excelforum.com/excel-programming-vba-macros/1057893-vb-code-get-2-latest-file-names-from-directory.html
' Poster:   Riz

Option Explicit

Function GetFileDates(ByVal Folderpath As Variant, ByVal Filename As String, Optional ByVal Descending As Boolean) As Variant

    Dim fDate   As Variant
    Dim fDates  As Variant
    Dim File    As Object
    Dim Files   As Object
    Dim Folder  As Variant
    Dim LB      As Long
    Dim j       As Long
    Dim n       As Long
    Dim Newest  As Date
    Dim Sorted  As Boolean
    Dim tmpDate As Variant
    Dim UB      As Long
    
    
        With CreateObject("Shell.Application")
            Set Folder = .Namespace(Folderpath)
            If Folder Is Nothing Then Exit Function
        End With
            
            Set Files = Folder.Items
                
            Files.Filter 64, Filename & "*.*"
                
            ReDim fDates(Files.Count - 1, 1)
            
          ' Save the file name and the data in fDates.
            For Each File In Files
              ' 3 = Date Modified, 4 = Date Created, 5 = Date Last Accessed
                fDates(n, 0) = File.Name
                fDates(n, 1) = CDate(Folder.GetDetailsOf(File, 4))
                n = n + 1
            Next File
            
          ' Sort the files by date using a modified bubble sort.
            LB = LBound(fDates, 1)
            UB = UBound(fDates, 1)
            
            Do
                n = 0
                
                For j = LB To UB - 1
                    If Descending Xor (fDates(j, 0) > fDates(j + 1, 0)) Then
                        tmpDate = fDates(j + 1, 0)
                        fDates(j + 1, 0) = fDates(j, 0)
                        fDates(j, 0) = tmpDate
                        
                        tmpDate = fDates(j + 1, 1)
                        fDates(j + 1, 1) = fDates(j, 1)
                        fDates(j, 1) = tmpDate
                        
                        n = j
                    End If
                Next j
                
                UB = n
                
            Loop Until UB = 0
            
        GetFileDates = fDates
        
End Function

Sub Macro1()

    Dim Cell        As Range
    Dim ChkBox      As Object
    Dim Filename    As String
    Dim Folderpath  As Variant
    Dim fDates      As Variant
    Dim Rng         As Range
    
        Set ChkBox = ActiveSheet.Shapes(Application.Caller)
        
        Set Rng = Range("K1", Cells(Rows.Count, "K").End(xlUp))
        
        If Rng Is Nothing Then Exit Sub
        
        For Each Cell In Rng
            If ChkBox.ControlFormat.Value = xlOn Then
                Folderpath = Cell & Cell.Offset(0, 1)
                Filename = Range("A15")
            
                fDates = GetFileDates(Folderpath, Filename, True)
            
                If Not IsEmpty(fDates) Then
                    Cell.Offset(0, 2).Resize(1, UBound(fDates) + 1).Value = Application.Transpose(Application.Index(fDates, 0, 1))
                End If
            Else
                If Not IsEmpty(Cell.Offset(0, 2)) Then
                    Range(Cell.Offset(0, 2), Cells(Cell.Row, Columns.Count).End(xlToLeft)).ClearContents
                End If
            End If
        Next Cell
        
End Sub

Hello Riz,

You're welcome. Look forward to hearing about the results.

Hello Riz,

This workbook will create a folder using the contents of cells K and L that are in the same row as the Check Box. All files that match or partially match the file name in cell A15 will be copied into cells M:Z starting with the file that was created most recently.

Here is the updarted code.

Option Explicit

Function GetFileDates(ByVal Folderpath As Variant, ByVal FileName As String, Optional ByVal Descending As Boolean) As Variant

    Dim fDate   As Variant
    Dim fDates  As Variant
    Dim File    As Object
    Dim Files   As Object
    Dim Folder  As Variant
    Dim LB      As Long
    Dim j       As Long
    Dim n       As Long
    Dim Newest  As Date
    Dim Sorted  As Boolean
    Dim tmpDate As Variant
    Dim UB      As Long
    
    
        With CreateObject("Shell.Application")
            Set Folder = .Namespace(Folderpath)
            If Folder Is Nothing Then Exit Function
        End With
            
            Set Files = Folder.Items
                
            Files.Filter 64, FileName & "*.*"
                
            If Files.Count = 0 Then Exit Function
            
            ReDim fDates(Files.Count - 1, 1)
            
          ' Save the file name and the data in fDates.
            For Each File In Files
              ' 3 = Date Modified, 4 = Date Created, 5 = Date Last Accessed
                fDates(n, 0) = File.Name
                fDates(n, 1) = CDate(Folder.GetDetailsOf(File, 4))
                n = n + 1
            Next File
            
          ' Sort the files by date using a modified bubble sort.
            LB = LBound(fDates, 1)
            UB = UBound(fDates, 1)
            
            Do
                n = 0
                
                For j = LB To UB - 1
                    If Descending Xor (fDates(j, 0) > fDates(j + 1, 0)) Then
                        tmpDate = fDates(j + 1, 0)
                        fDates(j + 1, 0) = fDates(j, 0)
                        fDates(j, 0) = tmpDate
                        
                        tmpDate = fDates(j + 1, 1)
                        fDates(j + 1, 1) = fDates(j, 1)
                        fDates(j, 1) = tmpDate
                        
                        n = j
                    End If
                Next j
                
                UB = n
                
            Loop Until UB = 0
            
        GetFileDates = fDates
        
End Function

Sub Macro1()

    Dim Cell        As Range
    Dim ChkBox      As Object
    Dim FileName    As String
    Dim Folderpath  As Variant
    Dim fDates      As Variant
    
        Set ChkBox = ActiveSheet.Shapes(Application.Caller)
        
        Set Cell = ChkBox.TopLeftCell
            
        If Not IsEmpty(Cell.Offset(0, 4)) Then
            Range(Cell.Offset(0, 4), Cells(Cell.Row, Columns.Count).End(xlToLeft)).ClearContents
        End If
            
            If ChkBox.ControlFormat.Value = xlOn Then
                Folderpath = Cell.Offset(0, 2) & Cell.Offset(0, 3)
                FileName = Range("A15")
            
                fDates = GetFileDates(Folderpath, FileName, True)
            
                If Not IsEmpty(fDates) Then
                    Cell.Offset(0, 4).Resize(1, UBound(fDates) + 1).Value = Application.Transpose(Application.Index(fDates, 0, 1))
                End If
            End If
        
End Sub

Hello Riz,

You're welcome. If and when you need help adding features, let me know. I would be glad to help.

Hello Riz,

I'll know more once I open the workbook but this sounds straight forward. The emails can be automated using Outlook.

I will code a routine you can run to place next check boxes in a cell so you want have to worry about proper alignment.

Hello Riz,

Sorry about the delay. My wife has the flu, her father has bronchitis, and our clothes washer broke. I tried to fix it yesterday but it was too rusted. We and bought a new one. Now, I am waiting for the delivery people to come.

Amidst all the chaos, I have managed to get the workbook changes made. The emails are displayed rather than sent so you can tell me what needs to changed without flooding your inbox during testing.

To add a new CheckBox to a cell use the hot key combination Ctrl+Shift+A. This will size the CheckBox to the cell's dimensions and attach it to "Macro1"in the workbook. The caption is "Send". You can change this if you want to. The macro is in the new module Ädd_Forms_CheckBox_To_Cell. The email is sent using the macro in the module Send_Email.

Test it and let me know what needs to added or changed.

Hello Riz,

The original layout had a single file name in A15. Has this changed...

I have loaded 3 files with criteria set in Cell A15 to the assigned directory in K1 and folder L1.

If so, please include an example of this new layout.

Hello Riz,

No confusion just can't exp[lain the error. I thought you might be accessing a network drive or had mapped a drive. Often times this can cause problems when accessing data due to permissions, passwords, etc.

The code runs for me with no problems whether I have a single attachment or seven.

Hello Riz,

Are the files on your hard disk or a network drive?

Hello Riz,

Why are all these files missing their file extensions?

Hello Riz,

Not sure if you are planning to email any Zipped files but I did discover one anomaly. Zip files are not listed. Technically a Zip file is a folder and not a file. I'll work on this problem also.

I tried removing the extensions from a few files to see if that caused the email problem but it didn't. I think it is time to punt.

When weird unexplainable problems like this happen, I defragment my registry. That usually clears the problems.

Hello Riz,

This workbook has a Command Button to send the emails. It tests the Check Boxes. If checked then the files from column "M" to the last column with a file name in it will be attached to the email address in column "B".

I tested this on several different folders on my computer using both local and remote disks. There were no problems. Try this out and let know what happens.

Hello Riz,

There is documentation of attachments to be sent not showing up in Outlook 2007/2010/2013 but for PDF files. Since your files do not have extension, I don't know if this applies to your situation.

I failed to find any settings in Outlook that would cause this problem. It is possible to hide an attachment by setting an argument value in the Add method for an Attachment object but the macro does not exercise this option.

Are you using Outlook as your primary email client?

Hello Riz,

I believe I know what was causing the problem. I had the Outlook 14 library loaded for reference and did not remove it before saving the workbook. The macro uses late binding to create the email through Outlook. I suspect there was a conflict between what was saved and what was loaded at run time. Outlook 2013 is version 15 and Outlook 2010 is version 14. Give this workbook a try and hopefully the problem will be solved.

Hello Riz,

Which version of Windows and Office are using?

Hello Riz,

Thanks for that info. Windows 8 is is most likely the problem here. I will do more research specific to Windows 8.

The code created for you and the macro I wrote are basically the same. The only differences are the cell referencing and my macro uses HTML message body and not plain text message body.

I can modify the macro to use plain text and see it that works.

Some Anti-Virus software will prevent Outlook 2013 from attaching and sending files. You may want to check which Add-Ins you have installed for Outlook.

If you are able to work with Outlook without any problem then the issue might be due to add-ins. In order to disable the add-ins follow the steps given below:

· In Outlook, click on File< Options< Add-ins.

· Under Manage select COM Add-ins.

· Click on GO options beside Manage, uncheck all the add-ins and click Ok.

· Try to open Outlook and check if it works fine.



If the issue occurs in safe mode too then create a new profile, configure the email account in new profile and check if it works fine in new profile. Refer the link mentioned below to create new profile:

How to create profile and set up an e-mail account in Outlook

Hello Riz,

Were the files saved without the PDF extension originally?

Hello Riz,

It looks like the the default setting of hiding file extensions affects the Shell Controls and Automation functions. Set Windows to show the file extensions.

Here is an article explaining it step by step for Windows 8.
How to Show File Extensions in Windows

Hello Riz,

This workbook has the extraneous code removed and copies the sent file names starting at cell "A51" and down.

Hello Riz,

You're welcome and I'll keep my fingers crossed for the live test.