Ouverture automatique fichier le plus récent

Sub TestGetLastFile()
   Const sPattern As String = "C:\Test\*.xls*"
   Dim sReturn As String
   
   sReturn = GetLastFile(sPattern)
   
   If sReturn = vbNullString Then
      MsgBox "No files found matching pattern: """ & _
         sPattern & """"
   Else
      MsgBox "The newest file matching pattern: """ & _
         sPattern & """ was found at: " & vbCr _
         & sReturn
   End If
End Sub

Function GetLastFile(sPattern As String) As String
'--returns path of the file meeting the pattern
'     with the newest modified date
Dim vMatches As Variant
Dim i As Long
Dim dModified As Double, dLastModified As Double
Dim sCommand As String

sCommand = "cmd /u/c dir " & """" & sPattern & """" _
   & " /B /O:D /S /T:W"

vMatches = Split(fShellRunUnicode(sCommand), vbCrLf)

For i = LBound(vMatches) To UBound(vMatches)
   If vMatches(i) <> "" Then
      dModified = FileDateTime(vMatches(i))
      If dModified > dLastModified Then
         dLastModified = dModified
         GetLastFile = vMatches(i)
      End If
   End If
Next i

End Function

Function fShellRunUnicode(sCommandStringToExecute)

' This function will accept a string as a DOS command to execute.
' It will then execute the command in a shell, and capture the output into a file.
' That file is then read in as Unicode and its contents are returned as the value the function returns.

Dim oShellObject, oFileSystemObject, sShellRndTmpFile
Dim oShellOutputFileToRead, iErr

Set oShellObject = CreateObject("Wscript.Shell")
Set oFileSystemObject = CreateObject("Scripting.FileSystemObject")

    sShellRndTmpFile = oShellObject.ExpandEnvironmentStrings("%temp%") & oFileSystemObject.GetTempName
    On Error Resume Next
    oShellObject.Run sCommandStringToExecute & " > " & sShellRndTmpFile, 0, True
    iErr = Err.Number

    On Error GoTo 0
    If iErr <> 0 Then
        fShellRunUnicode = ""
        Exit Function
    End If

    On Error GoTo err_skip
    fShellRunUnicode = oFileSystemObject.OpenTextFile(sShellRndTmpFile, 1, True, -1).ReadAll
    oFileSystemObject.DeleteFile sShellRndTmpFile, True

Exit Function

err_skip:
    fShellRunUnicode = ""
    oFileSystemObject.DeleteFile sShellRndTmpFile, True

End Function

Sub TestGetLastFile()
   Const sPattern As String = "C:\Temp\T*.xls"
   Dim sReturn As String
   
   sReturn = GetLastFile(sPattern)
   
   If sReturn = vbNullString Then
      MsgBox "No files found matching pattern: """ & _
         sPattern & """"
   Else
    Workbooks.Open sReturn
   End If
End Sub

Sub GetLatestFile()
'source: Conman Mai 2013
Dim strFolder$, strFile$, latestFile$, dtLast    As Date

strFolder = "C:\Temp\"
strFile = Dir(strFolder & "\T*.xls*", vbNormal) ' Excel Files

Do While strFile <> ""
    If FileDateTime(strFolder & strFile) > dtLast Then
        dtLast = FileDateTime(strFolder & strFile)
        latestFile = strFolder & strFile
    End If
    strFile = Dir
Loop
MsgBox latestFile
End Sub