Excel 2007/2010 – Finding The Most Or Least Recent File In A Folder

[wpfilebase tag=file id=3]

This page describes a VBA function named GetRecentFile. This function will return the name of the most recently modified or the least recently modified file in a specified folder. You can narrow the files to be examined by specifying one or more file extensions or you can examine all files in the folder.

The procedure declaration is as follows:

    Function GetRecentFile(DirPath As String, Extension As Variant, _

        Optional LeastRecent As Boolean = False) As String

The input parameters to GetRecentFile are as follows:

DirPath
This is the folder name to search. This must be a fully qualified (drive and folder name) path and the folder must exist. If the folder does not exist, the result of the function is vbNullString.

Extension
This specifies the extension(s) of the files to test. It may be (1) the string * or an empty string (vbNullString) to search all files in the folder, (2) a single string specifying the file extension (e.g., xls to look at Excel 97/2003 workbooks), (3) or an array of one or more file extensions (e.g., Array ("xls","xlsm","xlsx") for Excel 97/2003 and 2007 workbooks).

LeastRecent
This indicates whether to return the name of the least recently (oldest) or the most recently (newest) modified file. If this parameter is False or is omitted, the name of the most recently modified file is returned. If this parameter is True, the name of the least recently modified file is returned.

This procedure searches only the folder named in DirPath. It does not search subfolders of DirPath, subfolders of those subfolders, and so on.

 [tab: The Code]

The Code

You can download a module file containing the code below. The code for the GetRecentFile function is shown below.

Function GetRecentFile(DirPath As String, Extension As Variant, Optional LeastRecent As Boolean = False) As String
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' GetRecentFile
' By Chip Pearson, www.cpearson.com/Excel, [email protected]
'
' This procedure returns the most recent or least recent file name in a folder
' specified by DirPath having an extension specified by Extension.
' The parameters are as follows:
'
' DirPath The folder to search. This folder must be a fully
' qualified (drive and folder info) folder name and this
' folder must exist.
'
' Extension The file extension to match. This may be a simple string,
' (e.g., "xls" for Excel 97/2003 workbooks), an array of
' strings (e.g., Array("xls","xlsm","xlsx") for Excel
' 97/2003 and 2007 workbooks). If Extension is either
' vbNullString or "*", all file extensions are included.
'
' LeastRecent If omitted or FALSE, the most recently modified file
' is returned. If TRUE, the least recently modified file
' is returned.
'
' The result is the fully qualifed file name of the most or least recent file
' name or vbNullString if no matching files were found in DirPath. vbNullString
' is returned if DirPath does not exist or is not accessible.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Dim SaveDir As String           ' saved CurDir setting

    Dim FileName As String          ' FileName returned by Dir()

    Dim CompareDateTime As Double   ' Last date time of file

    Dim SaveFileName As String      ' Saved FileName

    Dim CurrFileDate As Double      ' Current file datetime returned by Dir()

    Dim Ext As String               ' Temporary file extension to test

    Dim CurrFileExt As String       ' Current file's extension 

    Dim N As Long                   ' Array index variable 

    Dim Pos As Long                 ' Position indicate of extension 

    Dim CompResult As Boolean       ' File test flag
    '''''''''''''''''''''''''''''''''''''''''''''
    ' Save the current working directory setting
    ' and then change the working directory to
    ' DirPath. Exit with result vbNullString if
    ' DirPath does not exist.
    '''''''''''''''''''''''''''''''''''''''''''''
    SaveDir = CurDir
    On Error Resume Next
    ChDrive DirPath
    If Err.Number <> 0 Then
        ' Debug.Print "Invalid Path: " & DirPath
        Exit Function
    End If
    ChDir DirPath
    If Err.Number <> 0 Then
        ' Debug.Print "Invalid Path: " & DirPath
        Exit Function
    End If
    ''''''''''''''''''''''''''''''''''''''''''''''
    ' Determine which file types to look at.
    ' If Extension is an array, look at all files.
    ' If Extension is vbNullString or "*", look
    ' at all files. If Extension is not an array
    ' and not "*" and not vbNullString, look
    ' only at the files with the specified
    ' extension. Call Dir() to prime the loop.
    '''''''''''''''''''''''''''''''''''''''''''''''
    If IsArray(Extension) = True Then
        FileName = Dir(DirPath & "*.*")
    Else
        If (StrComp(Extension, vbNullString, vbBinaryCompare) = 0) Or _
            (StrComp(Extension, "*", vbBinaryCompare) = 0) Then
            FileName = Dir(DirPath & "*.*")
        Else
            FileName = Dir(DirPath & "*." & Extension)
        End If
    End If
    ''''''''''''''''''''''''''''''''''''''''''''''
    ' If we are looking for the oldest file, we
    ' need to initialize CompareDateTime to a
    ' date past (greater than) any existing file
    ' date. Just use year = 9999.
    ''''''''''''''''''''''''''''''''''''''''''''''
    If LeastRecent = True Then
        CompareDateTime = DateSerial(9999, 1, 1)
    End If
    ''''''''''''''''''''''''''''''''''''''''''''''
    ' Look at all file names returned by Dir,
    ' looping until Dir returns a vbNullString.
    ''''''''''''''''''''''''''''''''''''''''''''''
    Do Until FileName = vbNullString
        FileName = DirPath & "" & FileName
        CurrFileDate = FileDateTime(FileName)
        CompResult = False
        '''''''''''''''''''''''''''''''''''''''''''''
        ' Test the current file's modification date
        ' against the stored CompareDateTime. If
        ' the datetime is less than the saved time
        ' (or greater than, in case LeastRecent is
        ' False), set the test flag to True.
        ' Otherwise, don't test the file.
        '''''''''''''''''''''''''''''''''''''''''''''
        If LeastRecent = True Then
            If CurrFileDate < CompareDateTime Then
                CompResult = True
            Else
                CompResult = False
            End If
        Else
            If CurrFileDate > CompareDateTime Then
                CompResult = True
            Else
                CompResult = False
            End If
        End If      �
      �
        If CompResult = True Then
            ''''''''''''''''''''''''''''''''''''''''''''''''''
            ' Get the extension of the current file
            ' and test it against either all the
            ' extensions in the Extension array or
            ' against the specified (single) extension
            ' or, if Extension is either "*" or vbNullString,
            ' against any extension.
            ''''''''''''''''''''''''''''''''''''''''''''''''''
            Pos = InStrRev(FileName, ".")
            If Pos > 0 Then
                CurrFileExt = Mid(FileName, Pos + 1)          �
                If IsArray(Extension) = True Then
                    ''''''''''''''''''''''''''''''''''''''
                    ' Extension is an array. Loop through
                    ' the extensions in the array. If two
                    ' filename differ only by extension and
                    ' have the same date/times, the last
                    ' one returned by Dir() will be the
                    ' result (very unlikely to occur).
                    ''''''''''''''''''''''''''''''''''''''
                    For N = LBound(Extension) To UBound(Extension)
                        Ext = Extension(N)
                        If StrComp(Ext, CurrFileExt, vbTextCompare) = 0 Then
                            CompareDateTime = CurrFileDate
                            SaveFileName = FileName
                        End If
                    Next N
                Else
                    ''''''''''''''''''''''''''''''''''''''''
                    ' If extension is a "*" or vbNullString,
                    ' then the current file becomes the
                    ' saved file (no testing of file extension
                    ' is done).
                    ''''''''''''''''''''''''''''''''''''''''
                    If (StrComp(Extension, "*", vbBinaryCompare) = 0) Or _
                        (StrComp(Extension, vbNullString, vbBinaryCompare) = 0) Then
                             CompareDateTime = CurrFileDate
                            SaveFileName = FileName
                    Else
                        '''''''''''''''''''''''''''''''''''''
                        ' Extension was specified. Ensure the
                        ' current FileName has the specified
                        ' extension.
                        '''''''''''''''''''''''''''''''''''''
                        If StrComp(CurrFileExt, Extension, vbTextCompare) = 0 Then
                             CompareDateTime = CurrFileDate
                            SaveFileName = FileName
                        End If
                    End If
                End If
      �
            End If
        End If
        '''''''''''''''''''''''''''''''
        ' Get the next file name from
        ' the Dir function.
        '''''''''''''''''''''''''''''''
        FileName = Dir()
    Loop
    '''''''''''''''''''''''''''''''''''
    ' Restore the current working
    ' directory and return SaveFileName
    ' as the result. If no matching file
    ' was found, SaveFileName will be
    ' vbNullString.
    '''''''''''''''''''''''''''''''''''
    ChDrive SaveDir
    ChDir SaveDir
    GetRecentFile = SaveFileName
End Function

[tab: Use the Function]

You can call the GetRecentFile function with code such as the following:

Sub AAA()
    Dim FileName As String
    Dim ModDate As Date
    Dim FilePath As String
    Dim Ext As Variant
    FilePath = "C:Temp" ' <<< Change to appropriate folder name
    'Ext = "" ' <<< SIMPLE STRING EXTENSION
    ' OR
    Ext = Array("xls", "xlsm", "xlsx") '<< ARRAY OF EXTENSIONS
    FileName = GetRecentFile(DirPath:=FilePath, Extension:=Ext, LeastRecent:=True)
    If FileName = vbNullString Then
        Debug.Print "No file found"
    Else
        ModDate = FileDateTime(FileName)
        Debug.Print "File: " & FileName, "Modified: " & ModDate
    End If
End Sub

[tab: Recursive Version]

Recursive Version

This version of the GetRecentFile recursively searches subfolders, their subfolders, and so on. The function declaration is:

Function GetRecentFile(FolderName As String, _
        Optional GetLeastRecent As Boolean = False, _
        Optional Recurse As Boolean = False) As String

The parameters are:

FolderName is the name of the folder in which to start the search.

GetLeastRecent indicates whether to find the most recent (if False) or the least recent (if True) file.

Recurse indicates whether to search subfolders (if True) or search only FolderName (if False).

[tab: Recursive Code]

Recursive Version Code

The recursive code is shown below. This code requires a reference to the scripting runtime library. In VBA, go to the Tools menu, choose References and scroll down to Microsoft Scripting Runtime and check that item.

Function GetRecentFile(FolderName As String, _
        Optional GetLeastRecent As Boolean = False, _
        Optional Recurse As Boolean = False) As String
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' GetRecentFile
' This function returns the full file name of the most or least
' recently modified file in the folder named in FolderName.
' Parameters:
'   FolderName      The name of the folder to search.
'   GetLeastRecent  If True, returns the file with the earliest
'                   modification date. If omitted or False, returns
'                   the file with the latest modification date.
'   Recurse         If False or omitted, only FolderName is searched.
'                   No subfolders are searched. If True, subfolders
'                   of FolderName and all child subfolders are searched.
' Return Value:     The fully qualified file name of the file with
'                   most (or least) modification date.
' Required References:
'                   Microsoft Scripting RunTime
'                       GUID: {420B2830-E718-11CF-893D-00A0C9054228}
'                       Major: 1    Minor: 0
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim FSO As Scripting.FileSystemObject
Dim RootFolder As Scripting.Folder
Dim RefFileName As String
Dim RefFileTime As Date
Dim F As Scripting.File
Dim SubF As Scripting.Folder

If Dir(FolderName, vbDirectory) = vbNullString Then
    GetRecentFile = vbNullString
    Exit Function
End If

If GetLeastRecent Then
    RefFileTime = Now
Else
    RefFileTime = 0
End If

Set FSO = New Scripting.FileSystemObject
Set RootFolder = FSO.GetFolder(FolderName)

For Each F In RootFolder.Files
    If GetLeastRecent Then
        If F.DateLastModified <= RefFileTime Then
            RefFileTime = F.DateLastModified
            RefFileName = F.Path
        End If
    Else
        If F.DateLastModified >= RefFileTime Then
            RefFileTime = F.DateLastModified
            RefFileName = F.Path
        End If
    End If
Next F
If Recurse = False Then
    GetRecentFile = RefFileName
    Exit Function
End If

For Each SubF In RootFolder.SubFolders
    DoSubFolder FSO, SubF, RefFileTime, RefFileName, GetLeastRecent
Next SubF

GetRecentFile = RefFileName

End Function

Sub DoSubFolder(FSO As Scripting.FileSystemObject, _
            FF As Scripting.Folder, _
            ByRef RefFileTime As Date, _
            ByRef RefFileName As String, _
            GetLeastRecent As Boolean)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' DoSubFolder
' This searches subfolders and their subfolders for the most
' (or least) recently modified file in the folder referenced
' by FF. It calls itself recursively to seach subfolders.
' Parameters:
'   FSO             A reference to an existing FileSystemObject.
'   FF              A reference to the folder to search
'   RefFileTime     A reference to the current most (or least)
'                   modification date.
'   RefFileName     A reference to the name of the most (or least)
'                   recently modified file.
'   GetLeastRecent  If True, searches for the oldest modified file.
'                   If False, searches for the newest modified file.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim F As Scripting.File
Dim SubF As Scripting.Folder

' search the files in folder FF
For Each F In FF.Files
    If GetLeastRecent Then
        If F.DateLastModified <= RefFileTime Then
            RefFileTime = F.DateLastModified
            RefFileName = F.Path
        End If
    Else
        If F.DateLastModified >= RefFileTime Then
            RefFileTime = F.DateLastModified
            RefFileName = F.Path
        End If
    End If
Next F

' call itself for all subfolders of folder FF.
For Each SubF In FF.SubFolders
    DoSubFolder FSO, SubF, RefFileTime, RefFileName, GetLeastRecent
Next SubF

End Sub

[tab:END]

SOURCE

LINK

LANGUAGE
ENGLISH