Function GetRecentFile(DirPath As String, Extension As Variant, _
Optional LeastRecent As Boolean = False) As String
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' GetRecentFile
' 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
'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 = "d:\documents and settings\ogo\Desktop" ' <<< 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)
MsgBox "File: " & FileName & " | " & "Modified: " & ModDate
End If
Workbooks.Open (FileName)
End Sub
'Open the workbook
Sub OpenWrkbk(FileName)
Workbooks.Open (FileName)
End Sub
