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

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
...

You could use Dir rather than FileSystemObject to retrieve a list of all the files and FileDateTime to get the last modified timestamp, then sort from that point. — PeterT
– PeterT, Commented Oct 10, 2022 at 16:31

Ron Rosenfeld · Accepted Answer · 2022-10-10 19:13:27Z

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

Collectives™ on Stack Overflow

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

1 Answer 1

Comments

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

1 Answer 1

Comments

Your Answer

Sign up or log in

Post as a guest

Related