Looping through a directory, speed test

That last post got me thinking I should share my routine for checking the speeds of the various ways to loop through a folder (vb's Dir, FileSystemObject, findfile APIs, excel's application.filesearch). It also would be a good way to put those methods out here for people to use, if you so choose.
I want to warn that you should probably delete your temporary internet files and possibly even your temporary files if you plan on doing this to your root C drive.

First, the results.
On my root C drive
FSO took 109.047000000002 seconds, 32297 files found
DIR took 73.8910000000013 seconds, 32297 files found
FileSearch took 234.421999999998 seconds, 31727 files found
APIs took 87.999999999998 seconds, 32296 files found

On a network drive
FSO took 3.60899999999802 seconds, 133 files found
DIR took 1.59400000000128 seconds, 133 files found
FileSearch took 0.999999999996682 seconds, 133 files found
APIs took 2.12499999999668 seconds, 133 files found

Taking a bit of a step back, here is the same test on a much bigger network drive
FSO took 801.625000000002 seconds, 8006 files found
DIR took 200.782000000003 seconds, 8006 files found
FileSearch took 77.5940000000007 seconds, 8006 files found
APIs took 282.483999999998 seconds, 8006 files found

These are pretty consistent with my original findings of it, kinda interesting that filesearch would be so slow on a local drive but much faster on network shares. Either way, it reaffirms my belief that Dir is the better overall method (filesearch was discontinued, obviously only works in VBA). The slight disparity of file counts (on my local drive) does concern me, though I can only assume (without delving further into it) that a file's attribute (system, hidden, etc) has something to do with it.

Take a look at the code I use to test this, if you see any kind of flaw in my logic I'd love to hear about improving it. Give it a shot on your own computer and see how it works out for you, and post back your results if you'd like!

Option Explicit
Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" ( _
  ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" ( _
  ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function GetFileAttributes Lib "kernel32" Alias "GetFileAttributesA" ( _
  ByVal lpFileName As String) As Long
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
Private Const MAX_PATH = 260
Private Const MAXDWORD = &HFFFF
Private Const INVALID_HANDLE_VALUE = -1
Private Const FILE_ATTRIBUTE_ARCHIVE = &H20
Private Const FILE_ATTRIBUTE_DIRECTORY = &H10
Private Const FILE_ATTRIBUTE_HIDDEN = &H2
Private Const FILE_ATTRIBUTE_NORMAL = &H80
Private Const FILE_ATTRIBUTE_READONLY = &H1
Private Const FILE_ATTRIBUTE_SYSTEM = &H4
Private Const FILE_ATTRIBUTE_TEMPORARY = &H100
Private Type FILETIME
 dwLowDateTime As Long
 dwHighDateTime As Long
End Type
Private Type WIN32_FIND_DATA
 dwFileAttributes As Long
 ftCreationTime As FILETIME
 ftLastAccessTime As FILETIME
 ftLastWriteTime As FILETIME
 nFileSizeHigh As Long
 nFileSizeLow As Long
 dwReserved0 As Long
 dwReserved1 As Long
 cFileName As String * MAX_PATH
 cAlternate As String * 14
End Type
Private FSO As Object

Sub SpeedTestCheckCDrive()
 Dim DirArray() As String, FSOArray() As String
 Dim FSArray() As String, APIArray() As String
 Dim i As Long, SearchPath As String
 Dim Timer1 As Double, Timer2 As Double, Timer3 As Double, Timer4 As Double
 
 SearchPath = "C:\"
 ReDim FSOArray(0)
 ReDim DirArray(1, 0)
 ReDim FSArray(0)
 ReDim APIArray(0)
 
 Timer1 = Timer
 Set FSO = CreateObject("scripting.filesystemobject")
 ReturnAllFilesUsingFSO SearchPath, FSOArray
 Set FSO = Nothing
 Timer1 = Timer - Timer1
DoEvents
 Timer2 = Timer
 ReturnAllFilesUsingDir SearchPath, DirArray
 Timer2 = Timer - Timer2
DoEvents
 Timer3 = Timer
 ReturnAllFilesUsingFileSearch SearchPath, FSArray
 Timer3 = Timer - Timer3
DoEvents
 Timer4 = Timer
 ReturnAllFilesUsingAPI SearchPath, APIArray
 Timer4 = Timer - Timer4
 
 Debug.Print Join(Array( _
  "FSO took " & Timer1 & " seconds, " & UBound(FSOArray) + 1 & " files found", _
  "DIR took " & Timer2 & " seconds, " & UBound(DirArray, 2) + 1 & " files found", _
  "FileSearch took " & Timer3 & " seconds, " & UBound(FSArray) + 1 & " files found", _
  "APIs took " & Timer4 & " seconds, " & UBound(APIArray) + 1 & " files found"), vbCrLf)
End Sub

Function ReturnAllFilesUsingDir(ByVal vPath As String, ByRef vsArray() _
  As String, Optional IncludeSubfolders As Boolean = True) As Boolean
 'You must send this a string array, ReDim'med to (1,0)
 ' (0,x) = path of file
 ' (1,x) = file name
 Dim TempStr As String, vDirs() As String, Cnt As Long, dirCnt As Long
 dirCnt = 0
 If Len(vsArray(0, 0)) = 0 Then
  Cnt = 0
 Else
  Cnt = UBound(vsArray, 2) + 1
 End If
 If Right(vPath, 1) <> "\" Then vPath = vPath & "\"
 
 If IncludeSubfolders Then
  On Error GoTo BadDir
  TempStr = Dir(vPath, 31)
  Do Until Len(TempStr) = 0
   If Asc(TempStr) <> 46 Then
    If GetAttr(vPath & TempStr) And vbDirectory Then
     ReDim Preserve vDirs(dirCnt)
     vDirs(dirCnt) = TempStr
     dirCnt = dirCnt + 1
     DoEvents
    End If
BadDirGo:
   End If
   TempStr = Dir
SkipDir:
  Loop
 End If
 
 On Error GoTo BadFile
 TempStr = Dir(vPath, 15)
 Do Until Len(TempStr) = 0
  ReDim Preserve vsArray(1, Cnt)
  vsArray(0, Cnt) = vPath
  vsArray(1, Cnt) = TempStr
  Cnt = Cnt + 1
  TempStr = Dir
  DoEvents
 Loop
BadFileGo:
 On Error GoTo 0
 If dirCnt > 0 Then
  For dirCnt = 0 To UBound(vDirs)
   If Len(Dir(vPath & vDirs(dirCnt))) = 0 Then
    GetFilesWithDir vPath & vDirs(dirCnt), vsArray
   End If
  Next
 End If
 Exit Function
BadDir:
 If TempStr = "pagefile.sys" Or TempStr = "???" Then
  Debug.Print "DIR: Skipping: " & vPath & TempStr
  Resume BadDirGo
 ElseIf Err.Number = 52 Then
  Debug.Print "No read dir rights: " & vPath & TempStr
  Resume SkipDir
 End If
 Debug.Print "Error with DIR Dir: " & Err.Number & " - " & Err.Description
 Exit Function
BadFile:
 If Err.Number = 52 Then
  Debug.Print "No read file rights: " & vPath & TempStr
 Else
  Debug.Print "Error with DIR File: " & Err.Number & " - " & Err.Description
 End If
 Resume BadFileGo
End Function

Function ReturnAllFilesUsingFSO(ByVal vPath As String, _
  ByRef vsArray() As String) As Boolean
 Dim f As Object, fld As Object, Cnt As Long
 Set fld = FSO.GetFolder(vPath)
 If Len(vsArray(0)) = 0 Then
  Cnt = 0
 Else
  Cnt = UBound(vsArray) + 1
 End If
 On Error GoTo UhOhs
 For Each f In fld.Files
  ReDim Preserve vsArray(Cnt)
  vsArray(Cnt) = f.Path
  Cnt = Cnt + 1
  DoEvents
 Next
 For Each f In fld.SubFolders
  ReturnAllFilesUsingFSO f.Path, vsArray
 Next
LaterGater:
 Set f = Nothing
 Set fld = Nothing
 Exit Function
UhOhs:
 If Err.Number = 70 Then
  Debug.Print "FSO Permission denied: " & vPath
 Else
  Debug.Print "Error with FSO: " & Err.Number & " - " & Err.Description
 End If
 Resume LaterGater
End Function

Function ReturnAllFilesUsingFileSearch(ByVal vPath As String, ByRef vsArray() _
  As String) As Long
 Dim i As Long, Cnt As Long
 With Application.FileSearch
  .NewSearch
  .SearchSubFolders = True
  .LookIn = vPath
  .FileType = msoFileTypeAllFiles
  If .Execute > 0 Then
   Cnt = 0
   On Error GoTo PermissionDenied
   ReDim Preserve vsArray(.FoundFiles.Count - 1)
   For i = 1 To .FoundFiles.Count
    vsArray(Cnt) = .FoundFiles(i)
    Cnt = Cnt + 1
SkipIt:
    DoEvents
   Next
  End If
 End With
 Exit Function
PermissionDenied:
 ReDim Preserve vsArray(UBound(vsArray) - 1)
 Resume SkipIt
End Function

Function ReturnAllFilesUsingAPI(vPath As String, ByRef vsArray() As String) As Boolean
 Dim FileName As String
 Dim DirName As String
 Dim dirNames() As String
 Dim nDir As Long
 Dim i As Long
 Dim hSearch As Long
 Dim WFD As WIN32_FIND_DATA
 Dim Cont As Long
 Dim Cnt As Long
 If Len(vsArray(0)) = 0 Then
  Cnt = 0
 Else
  Cnt = UBound(vsArray) + 1
 End If
 If Right(vPath, 1) <> "\" Then vPath = vPath & "\"
 nDir = 0
 ReDim dirNames(nDir)
 Cont = True
 hSearch = FindFirstFile(vPath & "*", WFD)
 If hSearch <> INVALID_HANDLE_VALUE Then
  Do While Cont
   DirName = StripNulls(WFD.cFileName)
   If (DirName <> ".") And (DirName <> "..") Then
    If GetFileAttributes(vPath & DirName) And FILE_ATTRIBUTE_DIRECTORY Then
     ReDim Preserve dirNames(nDir)
     dirNames(nDir) = DirName
     nDir = nDir + 1
     DoEvents
    End If
   End If
   Cont = FindNextFile(hSearch, WFD)
  Loop
  Cont = FindClose(hSearch)
 End If
 hSearch = FindFirstFile(vPath & "*", WFD)
 Cont = True
 If hSearch <> INVALID_HANDLE_VALUE Then
  While Cont
   FileName = StripNulls(WFD.cFileName)
    If (FileName <> ".") And (FileName <> "..") And ((GetFileAttributes(vPath _
      & FileName) And FILE_ATTRIBUTE_DIRECTORY) <> FILE_ATTRIBUTE_DIRECTORY) Then
     ReDim Preserve vsArray(Cnt)
     vsArray(Cnt) = vPath & FileName
     Cnt = Cnt + 1
    End If
   Cont = FindNextFile(hSearch, WFD)
  Wend
  Cont = FindClose(hSearch)
 End If
 If nDir > 0 Then
  For i = 0 To nDir - 1
   ReturnAllFilesUsingAPI vPath & dirNames(i) & "\", vsArray
  Next i
 End If
End Function

Private Function StripNulls(OriginalStr As String) As String
 If (InStr(OriginalStr, Chr(0)) > 0) Then
  OriginalStr = Left(OriginalStr, InStr(OriginalStr, Chr(0)) - 1)
 End If
 StripNulls = OriginalStr
End Function