Speed up the process

[ScotTFO]

I am currently using this code which does work, but it's SLOW...

I was wondering if there was an alternative method or a way I could speed up this code.

It's searching a directory and it's sub-directories for files that are either xls or doc then counting them all up.

    With Application.FileSearch
        .LookIn = strSourceFolder
        .FileType = msoFileTypeAllFiles
        .searchSubFolders = True
        .Execute
         
        For x = 1 To .FoundFiles.Count
            i = x
            On Error GoTo Skip
             
            Set objFile = objFSO.GetFile(.FoundFiles(x)) 
            If Right(objFile.Name, 3) = "xls" Or Right(objFile.Name, 3) = "doc" Then
                PopulateDirectoryList = PopulateDirectoryList + 1
            End If
            
Skip:
        Next x
         
    End With

Thanks!

 

[Jonmo1]

Perhaps this may be faster...

Sub Test()
Dim strSourceFolder As String
Dim x As Long
Dim PopulateDirectoryList As Long
Dim MyFileTypes As Variant
 
MyFileTypes = Array("*.xls", "*.doc")
strSourceFolder = "C:\Path"
 
For x = LBound(MyFileTypes) To UBound(MyFileTypes)
    With Application.FileSearch
        .LookIn = strSourceFolder
        .FileType = msoFileTypeAllFiles
        .SearchSubFolders = True
        .Filename = MyFileTypes(x)
        .Execute
    PopulateDirectoryList = PopulateDirectoryList + .FoundFiles.count
    End With
Next x
    
MsgBox PopulateDirectoryList
End Sub