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