VBA: Fast/efficient way to access excel file object properties - excel

Question

EDIT: I took PeterT's advice from comment and reprogrammed this using Dir() instead of FileSystem object. My new code, plus one alteration I made to it, scans my target directory in just about a minute. Still not ideal, but a huge improvement from where I started. If anyone knows how to further reduce the processing time, please, lmk!
The alteration is that I include the year in the Dir(filepath/filename) to search for, which should be the current year. I'm lucky in that the reference files have their dates saved as part of their filenames.
Note: Forgot to mention that the directory/reference files are saved on a network folder, which would lend to explain why accessing the file properties is taking soo long.
Here is the new code:
Public Function FindMostRecent_inYear() As String
'Debug
Dim i As Integer
i = 0
Dim StartTime As Double
Dim MinutesElapsed As String
'Remember time when macro starts
StartTime = Timer
Dim FolderName As String
Dim iFileName As String
Dim searchYear As String
searchYear = ActiveWorkbook.Sheets("CONFIG_MACRO").Range("A2").Value
Dim iDateLastMod As Date
Dim iFoundFile As String
Dim DateMax As Date
DateMax = 0
FolderName = "C:\Network\Folder\Data\"
iFileName = Dir(FolderName & "ALL_REF_FILES_START_W_THIS" & searchYear & "*.xlsx")
Do While iFileName <> ""
i = i + 1
iDateLastMod = FileDateTime(FolderName & iFileName)
If iDateLastMod > DateMax Then
iFoundFile = iFileName
DateMax = iDateLastMod
End If
iFileName = Dir()
Loop
MinutesElapsed = Format((Timer - StartTime) / 86400, "hh:mm:ss")
MsgBox "This code ran successfully in " & MinutesElapsed & " minutes", vbInformation
FindMostRecent_inYear = iFoundFile
End Function
!
My code is trying to scan a directory of excel files (~650 .xlsx files) and find the most recent modified file. It then returns the most recent modified file.
When I went to run it, it made excel non-responsive so I got to debugging, I found that it doesn't seem to be an infinite loop, rather an efficiency issue:
A few lines of code, which effectively is run ~650 times, take each anywhere from 1.4 s to 2.5 seconds each time. So at best its gonna take 30 mins for it to scan the whole directory, or longer.. waaay too long. The lines of code that are taking so long are accessing the properties of each file in the directory, specifically the file.Name, file.Type and the file.datelastmodified, such as:
iName = iFile.Name
iDateLastMod = iFile.datelastmodified
...
if iFile.Type = "Microsoft Excel Worksheet" Then
Is there anyway to check, in each iteration of 650, the file properties quickly?
I should note that I know for a fact all of the files in the directory are .xlsx files, So this I don't technically have to check, but I want to make my code failsafe, if I can. I do have to check the filename and date last modified..
Below is the code without debugging:
Public Function FindMostRecentWorkbook()
' iFile is iteration file
Dim iFile As Object
Dim DateMax As Date
Dim iFoundFile As Object
'RIDD_Folder is Raw Input Data Directory Folder
Dim RIDD_Folder As Object
Dim FileSysObj As Object
Dim strFileName As String
Set FileSysObj = CreateObject("scripting.filesystemobject")
Set RIDD_Folder = FileSysObj.GetFolder("C:\Filepath\Output\data\PROTECTED")
DateMax = 0
Dim iName As String
Dim iDateLastMod As Date
For Each iFile In RIDD_Folder.Files
iName = iFile.Name
iDateLastMod = iFile.datelastmodified
With iFile
If iFile.Type = "Microsoft Excel Worksheet" Then
If iName Like "ALL_REF_FILES_START_W_THIS" And iDateLastMod > DateMax Then
Set iFoundFile = iFile
DateMax = iDateLastMod
End If
End If
End With
Next iFile
Set FindMostRecentWorkbook = iFoundFile
End Function
Here is the code with debugging included:
Public Function FindMostRecentWorkbook()
'Debug code
'iterations
Dim c, x, i, iLike As Integer
c = 0
x = 0
i = 0
iLike = 0
'timer
Dim StartTime_Assign, StartTime_With, StartTime_IfType, StartTime_IfName As Double
Dim SecondsElapsed As Double
' iFile is iteration file
Dim iFile As Object
Dim DateMax As Date
Dim iFoundFile As Object
'RIDD_Folder is Raw Input Data Directory Folder
Dim RIDD_Folder As Object
Dim FileSysObj As Object
Dim strFileName As String
Set FileSysObj = CreateObject("scripting.filesystemobject")
Set RIDD_Folder = FileSysObj.GetFolder("C:\Filepath\Output\data\PROTECTED")
DateMax = 0
Dim iName As String
Dim iDateLastMod As Date
'Dim iFileType As Type
For Each iFile In RIDD_Folder.Files
i = i + 1
StartTime_Assign = Timer
iName = iFile.Name
iDateLastMod = iFile.datelastmodified
SecondsElapsed = Round(Timer - StartTime_Assign, 2)
Debug.Print "Time elapsed in Assign:" & SecondsElapsed
StartTime_With = Timer
With iFile
StartTime_IfType = Timer
If iFile.Type = "Microsoft Excel Worksheet" Then
StartTime_IfName = Timer
If iName Like "ALL_REF_FILES_START_W_THIS" And iDateLastMod > DateMax Then
iLike = iLike + 1
Set iFoundFile = iFile
DateMax = iDateLastMod
End If
SecondsElapsed = Round(Timer - StartTime_IfName, 2)
Debug.Print "Time elapsed in If iName Like ....:" & SecondsElapsed
End If
SecondsElapsed = Round(Timer - StartTime_IfType, 2)
Debug.Print "Time elapsed in If iFile.Type = ...:" & SecondsElapsed
End With
SecondsElapsed = Round(Timer - StartTime_With, 2)
Debug.Print "Time elapsed in With iFile:" & SecondsElapsed
If (((i / 10) <> 0) And ((i Mod 10) = 0)) Then
'breakpoint on below line
x = x + 1
End If
If (((i / 100) <> 0) And ((i Mod 100) = 0)) Then
c = c + 1
End If
Next iFile
Set FindMostRecentWorkbook = iFoundFile
End Function
When tested this debug code printed this:
Time elapsed in Assign:2.49000000953674
Time elapsed in If iName Like ....:0
Time elapsed in If iFile.Type = ...:1.5
Time elapsed in With iFile:0
Time elapsed in Assign:1.73000001907349
Time elapsed in If iName Like ....:0
Time elapsed in If iFile.Type = ...:1.6599999666214
Time elapsed in With iFile:0
Time elapsed in Assign:1.76999998092651
Time elapsed in If iName Like ....:0
Time elapsed in If iFile.Type = ...:1.51999998092651
Time elapsed in With iFile:0
Time elapsed in Assign:1.75
Time elapsed in If iName Like ....:0
Time elapsed in If iFile.Type = ...:1.5
Time elapsed in With iFile:0
...

Answer 1

In doing some testing where I had to read the directory for a large number of files from a network drive, I found that the windows Command Prompt dir command executed much faster than the VBA dir command or the FileSystemObject.
I also found that writing the results to a temporary file resulted in no screen flickering, whereas I had problems with screens when trying to read it directly into VBA.
In the code below, I make use of that. I have used arguments for the dir command so that it returns the desired files sorted in reverse order by date/time last written.
Also, note the use of arguments and wild cards to construct a string which includes the base folder, the starting part of the file name, and the various xls file extensions.
Since dir will return the file list properly sorted, one only needs to return the first entry in the file.
Also note that I used early-binding, but you could convert to late-binding if inconvenient.
At the end, I debug.print the full path of the most recent file.
I can't imagine this would take more than a second to locate the most recent excel file.
'Set References:
' Windows Script Host Object Model
' Microsoft Scripting Runtime
Option Explicit
Sub GetMostRecentFile()
Dim WSH As WshShell, lErrCode As Long
Dim FSO As FileSystemObject, TS As TextStream
Dim sTemp As String
Dim MostRecentFile As String
Const sRIDD_Folder_Path As String = "c:\users\ron\documents\" 'note terminal backslash
Const sFileSpec As String = "Book1*.xls*"
sTemp = Environ("Temp") & "\FileList.txt"
Set WSH = New WshShell
'note /U to enable Unicode output, as some names have char codes > 127 which are altered by redirection
lErrCode = WSH.Run("CMD /U /c dir """ & sRIDD_Folder_Path & sFileSpec & """ /TW /O-d /B > " & sTemp, xlHidden, True)
If Not lErrCode = 0 Then
MsgBox "Problem Reading Directory" & _
vbLf & "Error Code " & lErrCode
Exit Sub
End If
Set FSO = New FileSystemObject
Set TS = FSO.OpenTextFile(sTemp, ForReading, False, TristateTrue)
MostRecentFile = Split(TS.ReadAll, vbLf)(0)
TS.Close
FSO.DeleteFile sTemp
Set FSO = Nothing
Debug.Print sRIDD_Folder_Path & MostRecentFile
End Sub