Option Explicit
Public Sub GetMostRecentlyFile()
Dim oDict As Object
Dim oFSO As Object
Dim oFile As Object
Dim sPath As String
Dim sFileName As String
Dim sFileDate As Date
sPath = "D:\User\Downloads"
Set oFSO = CreateObject("Scripting.FileSystemObject")
If oFSO.FolderExists(sPath) Then
Set oDict = CreateObject("Scripting.Dictionary")
For Each oFile In oFSO.GetFolder(sPath).Files
oDict.Add oFile.Name, oFile.DateCreated
Next oFile
Set oDict = DictSortByValue(oDict, xlDescending)
sFileName = oDict.Keys()(0)
sFileDate = oDict.Items()(0)
MsgBox "The most recently created file in" & vbCrLf & _
sPath & vbCrLf & _
"is: " & sFileName & vbCrLf & _
"created on: " & sFileDate, vbInformation, "GetMostRecentlyFile"
oDict.RemoveAll
Set oDict = Nothing
Else
MsgBox "Folder " & sPath & " does not exist.", vbExclamation, "GetMostRecentlyFile"
End If
SUB_QUIT:
Set oFSO = Nothing
End Sub
Public Function DictSortByValue(argDict As Object, Optional argSortOrder As XlSortOrder = xlAscending) As Object
Dim arrList As Object
Dim dictTmp As Object
Dim coll As Collection
Dim vKey As Variant
Dim vValue As Variant
Dim vItem As Variant
Set arrList = CreateObject("System.Collections.ArrayList")
Set dictTmp = CreateObject("Scripting.Dictionary")
On Error GoTo SUB_ERROR
For Each vKey In argDict
vValue = argDict(vKey)
If Not dictTmp.Exists(vValue) Then
Set coll = New Collection
dictTmp.Add vValue, coll
arrList.Add vValue
End If
dictTmp(vValue).Add vKey
Next vKey
arrList.Sort
If argSortOrder = xlDescending Then
arrList.Reverse
End If
argDict.RemoveAll
For Each vValue In arrList
Set coll = dictTmp(vValue)
For Each vItem In coll
argDict.Add vItem, vValue
Next vItem
Next vValue
Set arrList = Nothing
Set DictSortByValue = argDict
SUB_DONE:
Exit Function
SUB_ERROR:
If Err.Number = 450 Then
Err.Clear
arrList.Clear
Set arrList = Nothing
Set dictTmp = Nothing
Set coll = Nothing
Err.Raise Number:=vbObjectError + 100, _
SOURCE:="Procedure: DictSortByValue", _
Description:="Cannot sort the dictionary if the value is an object"
End If
End Function