How to traverse files (conditionally) faster than using FileSystemObject - excel

Question

I've written some VBA code using file objects to go into a folder, search for particular files (CSV) that meet certain criteria (contain "HR" in filename and created within specified date range), and copy/paste information out of that file into a master file. The master file is typically a compilation of 250+ workbooks.
The macro works as it should, but it takes about 12 minutes to run, which is a bit excessive. I believe it takes so long to run because it is indexing a folder with 30,000+ files in it.
I've copied the relevant lines of my code below, if anyone is aware of any modifications I could make that would decrease the duration of my macro, I would really appreciate it. I'm relatively new to VBA and coding in general, so I'm learning as I go with these sorts of things! Thanks!
Dim FilePath As String
Dim FileName As String
Dim objFSO As FileSystemObject
Dim objFolder As Folder
Dim objFile As file
Dim fileDate As Date
Dim firstDate As Date
Dim secondDate As Date
'Defining the user-input variables
Worksheets("Sheet1").Activate
firstDate = Cells(2, "E").Value
secondDate = Cells(3, "E").Value
'FilePath to information, defining file objects
FilePath = "\\SRV-1\process\DUMP\"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(FilePath)
'Going through Dump folder and finding high resolution files created within the date range
For Each objFile In objFolder.Files
'Checking to see if the file contains the string "HR", indicating high resolution.
If InStr(1, objFile.Name, "HR") Then GoTo Line1 Else GoTo Line3
Line1:
'Storing the file as a variable and checking its creation date
FileName = objFile.Name
OpenFile = FilePath & FileName
fileDate = FileDateTime(OpenFile)
'Checking to see if the file was created between the user input master roll start/end dates
If firstDate < fileDate And secondDate > fileDate Then GoTo Line2 Else GoTo Line3
Line2:
Do stuff: open dump workbook, copy/pase certain range into main workbook, close dump workbook, next objFile
Line3:
Next objFile

Answer 1

This ought to show some improvement, considering the ratio of HR files to total files (250 / 30,000).
Using Dir Function, Minimize reliance on FileSystemObject
The idea here is to use the Dir function first to get a list of all file names that contain the "HR" substring, and only use the FileSystemObject against those files to get the timestamp information -- there's no use incurring the overhead of FSO on every file in that directory.
Then, we process only those files which match the "HR" criteria:
Sub usingDir()
Dim folderPath As String
Dim fileName As String
Dim filesToProcess As New Collection
Dim item As Variant
Dim fileDate As Date
Dim firstDate As Date
Dim secondDate As Date
'Defining the user-input variables
firstDate = Cells(2, "E").Value
secondDate = Cells(3, "E").Value
folderPath = "\\SRV-1\process\DUMP\"
' Gets a collection of files matching the "HR" criteria
fileName = Dir(folderPath)
Do While Not fileName = ""
If InStr(fileName, "HR") > 0 Then
'Only processing files with "HR"
filesToProcess.Add (folderPath & fileName)
End If
fileName = Dir
Loop
'Now we deal only with the "HR" files:
With CreateObject("Scripting.FileSystemObject")
For Each item In filesToProcess
' Check the date last modified
fileDate = .GetFile(item).DateLastModified ' modify as needed
If firstDate < fileDate And secondDate > fileDate Then
'
'
Debug.Print item
'your code to Do Stuff goes here
'
'
'
End If
Next
End With
End Sub
UPDATE: Without Using the FileSystemObject
This was nagging at me, and I figured there must be a way to get the timestamp information without relying on FileSystemObject. There is. We'll still use Dir to traverse the files, but now we'll eliminate any reference to FileSystemObject and replace with some fancy WinAPI function calls. Check out Chip Pearson's article here and download the .bas modules. You'll need the following two files imported to your VBProject:
modGetSetFileTimes
modTimeConversionFunctions
And then you can do something like this:
Option Explicit
Sub withoutFSO()
Dim folderPath As String
Dim FileName As String
Dim filesToProcess As New Collection
Dim item As Variant
Dim fileDate As Date
Dim firstDate As Date
Dim secondDate As Date
'Defining the user-input variables
firstDate = Cells(2, "E").Value
secondDate = Cells(3, "E").Value
folderPath = "\\Your\Path"
' Gets a collection of files matching the "HR" criteria and our Date range
FileName = Dir(folderPath)
Do While Not FileName = ""
'Only processing files with "HR"
If InStr(FileName, "HR") > 0 Then
' Only process files that meet our date criteria
fileDate = CDate(modGetSetFileTimes.GetFileDateTime(CStr(item), FileDateLastModified))
If firstDate < fileDate And secondDate > fileDate Then
filesToProcess.Add (folderPath & FileName)
End If
End If
FileName = Dir
Loop
'Now we deal only with the matching files:
For Each item In filesToProcess
Debug.Print item
Debug.Print fileDate
'your code to Do Stuff goes here
'
'
'
Next
End Sub
This should be an improvement even over my original answer, and, if combined with a more efficient manner of retrieving data (i.e., using ADO instead of Workbooks.Open, if possible) then you should be very optimized.

Answer 2

Take a look at Power Query -- it's a Microsoft add-in for Excel versions 2012 & 2013, and built-in to 2016. Setting up PQ to do this will be amazingly fast, and the 'script' is reusable! No VBA needed.
You can search and combine the multiple files on the specified criteria, but then merge or append to the new/master file, too. For efficiency, rather than processing each file individually, might I suggest gathering up all the data files (by your criteria), combining them to one table, then use the new table to merge/append to the new/master
Hope this helps...

Answer 3

In addition to using the Dir function instead of FileSystemObject, if you cannot automate PowerQuery, and all you need is the data and not the formatting, consider making a direct data connection to the source workbooks using ADODB.
Add a reference to Microsoft ActiveX Data Objects 6.1 Library (via Tools -> References...). There may be versions other than 6.1; choose the highest.
Then you can use something like the following code:
Dim fso As New Scripting.FileSystemObject
Dim filepath As Variant
For Each filepath In filesToProcess
' Check the date last modified
fileDate = fso.GetFile(item).DateLastModified ' modify as needed
If firstDate < fileDate And secondDate > fileDate Then
Dim connectionString As String
connectionString = _
"Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=""" & filepath & """;" & _
"Extended Properties=""Excel 12.0;HDR=No"""
Dim worksheetName As String
worksheetName = "Sheet1"
' There can be multiple worksheets per workbook.
' If you are only interested in one worksheet per workbook, then fill in worksheetName somehow
' Otherwise, you will probably need an inner loop to iterate over all the worksheets
Dim sql As String
sql = _
"SELECT * " & _
"FROM [" & worksheetName & "$]"
Dim rs As New ADODB.Recordset
rs.Open sql, connectionString
destinationWorksheet.Range("A1").CopyFromRecordset rs
rs.Close
Set rs = Nothing
End If
Next

Answer 4

It took a long time because for each interation you pass the information to the main worksheet.
In this case is better use a multidimensional array to keep the information and in the end of the process you pass the the array info in the main worksheet.
I dont know what information you get in each worksheet, soo i cant create an didatical example for you.