Loop through all files within a directory

Another thing I see a lot is where someone wants to loop through a directory (and/or subfolders). There are a number of ways to do this, such as VB's Dir() method, FileSystemObject, FindFirstFile/FindNextFile APIs, even Application.FileSearch (up through excel 2003, I believe). I have done a few speed tests for various threads, and usually find Dir() to be the quickest (usually true for local disks; network shares seem to vary). Dir is also the one I go with the most, as it doesn't require and early/late binding for FSO, and needs no API declare statements.

Note that if you're working in VBScript, you will have to use FileSystemObject, as Dir() doesn't exist in VBS and APIs are more trouble than they're worth if you want to use them (you'd have to create a container class in vb to use them in vbs).

Here is an example of looping through all the files within a specific directory; my calling subroutine just sends a message box with the number of files contained, but it can obviously do much more. I'm also including a simple routine called DesktopAddress, should anyone ever want to know the desktop's location via code (I use this is many of my distributed projects at work, actually). Run the LoopThroughAllFilesInDirectory to return a filecount of files on your desktop, and change as needed!

Sub LoopThroughAllFilesInDirectory()
 Dim vFiles() As String, i As Long
 ReDim vFiles(1, 0)
 GetFilesWithDir DesktopAddress, vFiles 'all files desktop + below
 MsgBox "You have " & CStr(UBound(vFiles, 2) + 1) & " files on your desktop"
End Sub
Function DesktopAddress() As String
 Dim vShell As Object, vDesktop As String
 Set vShell = CreateObject("WScript.Shell")
 vDesktop = vShell.SpecialFolders("Desktop")
 If Right(vDesktop, 1) <> "\" Then vDesktop = vDesktop & "\"
 DesktopAddress = vDesktop
 Set vShell = Nothing
End Function

Function GetFilesWithDir(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
    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
 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