Открыть все файлы с частичным именем в подпапках – VBA

Я пытаюсь открыть все файлы с именами, заканчивающимися ToDo.xlsx, выполнив цикл, который проходит через все подпапки.

Я нашел этот цикл в другом столбце в StackOverflow, но это занимает слишком много времени, когда есть много файлов (~ 35k в моем случае):

Public Sub NonRecursiveMethod() Dim fso, oFolder, oSubfolder, oFile, queue As Collection Set fso = CreateObject("Scripting.FileSystemObject") Set queue = New Collection queue.Add fso.GetFolder("your folder path variable") 'obviously replace Do While queue.Count > 0 Set oFolder = queue(1) queue.Remove 1 'dequeue '...insert any folder processing code here... For Each oSubfolder In oFolder.SubFolders queue.Add oSubfolder 'enqueue Next oSubfolder For Each oFile In oFolder.Files '...insert any file processing code here... Next oFile Loop End Sub 

Мой код обработки:

 If InStr(oFile.Name,"ToDo"= <> 0 Then Workbooks.Open Filename:=oSubfolder & oFile 

Есть ли способ поставить это условие в цикл for, чтобы минимизировать время обработки?

спасибо

 filename = Dir(oFolder.Name & "\*ToDo.xlsx") While (filename <> "") ' processing... Full name is oFolder.Name & "\" & filename filename = Dir Wend