更快地search文件夹/子文件夹

我试图在我们的Sharepoint站点及其子文件夹中search符合某些标准的Excel文档的多个文件夹，然后将工作簿中的数据复制到摘要书（实际上并不需要该部分的帮助）。 我搜遍了，并提出了下面的代码，但它是慢得可笑（我有接近1000个文件夹每个有多个子文件夹通过）。 我很好奇，如果有人知道一个更快的方式，因为这个周末可以运行，而且还没有接近。

Sub Main() On Error GoTo ErrHandler Dim fso, oFolder, oSubfolder, oFile, queue As Collection Dim StartTime As Double Dim MinutesElapsed, FileString As String Const MyDir As String = "\\hp.sharepoint.com@SSL\..." ' Remember time macro starts StartTime = Timer Set fso = CreateObject("Scripting.FileSystemObject") Set queue = New Collection queue.Add fso.GetFolder(MyDir) Do While queue.Count > 0 Set oFolder = queue(1) queue.Remove 1 'dequeue For Each oSubfolder In oFolder.SubFolders queue.Add oSubfolder 'enqueue Next oSubfolder For Each oFile In oFolder.Files FileString = fso.GetFileName(oFile) If InStr(FileString, "FAI") > 0 Then Call FAI(oFile) ' Copies data from files ElseIf InStr(FileString, "CPK") > 0 Then Call CPK(oFile) ' Copies data from files End If Next oFile Loop Application.CutCopyMode = False ActiveSheet.Range("A1").Select 'Determine how long code took to run MinutesElapsed = Format((Timer - StartTime) / 86400, "hh:mm:ss") Debug.Print "This code ran successfully in " & MinutesElapsed, vbInformation Exit Sub ErrHandler: Debug.Print Err.Number & " " & Err.Description Resume Next End Sub