Reputation: 53
I need to search the file system (a drive usually) for a fully defined file path while given only a fragment of the file name.
The fragment is actually the part number of the part, and the files to search are all of type '.idw'. Further, they are named with a series that helps sort them; ie 1XX-XXXX.idw, 2XX-XXX.idw.
There are 50,000+ files and just using a FileScriptingObject and recursive reading each folder then comparing them takes something like 2 minutes per search.
(Given a list of part numbers, I need to populate a column in Excel with the full file name)
I'm guessing my best way to go about this is to generate an indexed list of all of the idw files I'm looking for, reducing the full file string to only the base name and using that as the key. However, this would still required the timely run at the start of each search assuming I use this dictionary/collection/list over and over per run.
Is there any way to store a dictionary in an external file, so I can generate the indexed list once per day or a lot less frequently?
Otherwise, is there a better way to do this with VBA that I have not thought of?
Upvotes: 0
Views: 911
Reputation: 19319
Following up the comment from @omegastripes, you can combine three methods to achieve the objective.
Exec
method of WScript.Shell
to run a Dir
command - likely faster than using FileSystemObject
Split
the StdOut
to get a Variant
array of all the filenames returned - this is the one-time hit to get the list of files you want to search overFilter
function to reduce the array to just the filenames including the ones you are interested in displaying on the spreadsheet.The DIR
command leverages some switches that are important to the task:
/S
- recursive through sub-directories/B
- bare names only/A:-D
- exclude directories from output, i.e. files onlyHere's the sample code:
Option Explicit
Sub Test()
Dim arrFiles As Variant
Dim arrSearchTerms As Variant
Dim arrMatches As Variant
Dim intTargetCounter As Integer
Dim intMatchCounter As Integer
'get files
arrFiles = GetFileList("C:\WINDOWS", "idw")
If UBound(arrFiles) = 0 Then
MsgBox "No files found"
Exit Sub
End If
'iterate search terms and check collection
arrSearchTerms = Array("1XX-XXXX", "2XX-XXXX")
For intTargetCounter = LBound(arrSearchTerms) To UBound(arrSearchTerms)
arrMatches = Filter(arrFiles, arrSearchTerms(intTargetCounter))
For intMatchCounter = LBound(arrMatches) To UBound(arrMatches)
Debug.Print arrMatches(intMatchCounter)
Next intMatchCounter
Next intTargetCounter
End Sub
Function GetFileList(strRoot As String, strExtensionFilter As String) As Variant
Dim objShell As Object
Dim strCommand As String
Dim objShellExe As Object
On Error GoTo CleanUp
'call cmd
Set objShell = CreateObject("WScript.Shell")
strCommand = "%COMSPEC% /C DIR /S /B /A:-D *." & strExtensionFilter
objShell.CurrentDirectory = strRoot
Set objShellExe = objShell.Exec(strCommand)
'wait for listing
While objShellExe.Status <> 1
DoEvents
Wend
'convert std out to array
GetFileList = Split(objShellExe.StdOut.ReadAll, vbCrLf)
CleanUp:
If Err.Number <> 0 Then
Debug.Print Err.Number & ": " & Err.Description
End If
Set objShellExe = Nothing
Set objShell = Nothing
End Function
Upvotes: 1