By using API calls from VB6, we can quickly find the most recently used file, quickly.
The code below is optimized to quickly find the most recently used file in a specified directory and returns its full name. I’ve also attached a sample project that contains the same information, for easy incorporation in to your project.
Note
This code was originally contributed by Andrew Baker to vbusers.com.
The site has not been in operation for a number of years; the content is included here in order to preserve it for the future.
Option Explicit
Private Const MAX_PATH As Long = 260
Private Const INVALID_HANDLE_VALUE As Long = -1
Private Const FILE_ATTRIBUTE_ARCHIVE As Long = &H20;
Private Const FILE_ATTRIBUTE_COMPRESSED As Long = &H800;
Private Const FILE_ATTRIBUTE_DIRECTORY As Long = &H10;
Private Const FILE_ATTRIBUTE_HIDDEN As Long = &H2;
Private Const FILE_ATTRIBUTE_NORMAL As Long = &H80;
Private Const FILE_ATTRIBUTE_READONLY As Long = &H1;
Private Const FILE_ATTRIBUTE_TEMPORARY As Long = &H100;
Private Const FILE_ATTRIBUTE_FLAGS = FILE_ATTRIBUTE_ARCHIVE Or FILE_ATTRIBUTE_HIDDEN Or FILE_ATTRIBUTE_NORMAL Or FILE_ATTRIBUTE_READONLY
Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Private Type SYSTEMTIME
wYear As Integer
wMonth As Integer
wDayOfWeek As Integer
wDay As Integer
wHour As Integer
wMinute As Integer
wSecond As Integer
wMilliseconds As Integer
End Type
Private Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * MAX_PATH
cAlternate As String * 14
End Type
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function SearchTreeForFile Lib "imagehlp.dll" (ByVal sFileRoot As String, ByVal InputPathName As String, ByVal OutputPathBuffer As String) As Boolean
Private Declare Function FileTimeToLocalFileTime Lib "kernel32" (lpFileTime As FILETIME, lpLocalFileTime As FILETIME) As Long
Private Declare Function FileTimeToSystemTime Lib "kernel32" (lpFileTime As FILETIME, lpSystemTime As SYSTEMTIME) As Long
'Purpose : Performs a recursive search for a file or file pattern.
'Inputs : asMatchingFiles See outputs.
' sRootPath The path to begin the search from eg. "C:\"
' sSearchFor The file name or pattern to search for eg. "Test.xls" or "*.xls"
' bRecursiveSearch If True searchs all subfolders in sRootPath for matching files.
'Outputs : asMatchingFiles A one based, 1d string array containing the paths and names of
' the matching files. SEE NOTES.
' Returns the number of matching files.
'Author : Andrew Baker
'Date : 02/10/2000 15:11
'Notes : Example:
' FileSearch asFiles, "C:\", "*.ocx", True 'Populates asFiles with all the .ocx files on your C: drive
'Revisions :
Function GetMostRecentFileName(ByVal sRootPath As String, Optional sPattern As String = "*") As String
Dim tFindFile As WIN32_FIND_DATA
Dim lHwndFile As Long
Dim sItemName As String, sThisPath As String
Dim dtMostRecentLastMod As Date, dtThisFileMod As Date
Dim sMostRecentFile As String
Dim tThisFileTime As FILETIME
Dim tThisFileSysTime As SYSTEMTIME
On Error Resume Next
If Right$(sRootPath, 1) <> "\" Then
sRootPath = sRootPath & "\"
End If
'Get handle to folder
lHwndFile = FindFirstFile(sRootPath & sPattern, tFindFile)
If lHwndFile <> INVALID_HANDLE_VALUE Then
'-------Found a matching file, loop over other matching files
Do
If (tFindFile.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) = False Then
'Found file
sItemName = Left$(tFindFile.cFileName, InStr(1, tFindFile.cFileName, vbNullChar) - 1)
If Len(sMostRecentFile) = 0 Then
sMostRecentFile = sRootPath & sItemName
Else
tThisFileTime = tFindFile.ftLastAccessTime
FileTimeToLocalFileTime tThisFileTime, tThisFileTime
FileTimeToSystemTime tThisFileTime, tThisFileSysTime
dtThisFileMod = DateSerial(tThisFileSysTime.wYear, tThisFileSysTime.wMonth, tThisFileSysTime.wDay) + TimeSerial(tThisFileSysTime.wHour, tThisFileSysTime.wMinute, tThisFileSysTime.wSecond)
If dtThisFileMod > dtMostRecentLastMod Then
sMostRecentFile = sRootPath & sItemName
dtMostRecentLastMod = dtThisFileMod
End If
End If
End If
Loop While FindNextFile(lHwndFile, tFindFile)
'Close find handle
lHwndFile = FindClose(lHwndFile)
End If
GetMostRecentFileName = sMostRecentFile
End Function
'Demonstration routine
Sub Test()
Dim sMostRecentFile As String
sMostRecentFile = GetMostRecentFileName("\\ldnpsm020161\FTP\Compliance")
Debug.Print sMostRecentFile
End Sub
Attachments
| File | Uploaded | Size |
|---|---|---|
| 389-20190302-115737-FileLastModified.zip | 3/2/2019 11:57:37 AM | 2748 |