[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 StringThe 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 StringThe 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 |