Question

我正在尝试搜索Sharepoint网站上的多个文件夹及其符合某些条件的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

更快地搜索文件夹/子文件夹

0 个答案: