FilesSearch

Sub FilesSearch(DrivePath As String, Ext As String)
Dim XDir() As String
Dim TmpDir As String
Dim FFound As String
Dim DirCount As Integer
Dim X As Integer
'Initialises Variables
DirCount = 0
ReDim XDir(0) As String
XDir(DirCount) = ""
If Right(DrivePath, 1) <> "\" Then
  DrivePath = DrivePath & "\"
End If
'Enter here the code for showing the path being
'search. Example: Form1.label2 = DrivePath
'Search for all directories and store in the
'XDir() variable
DoEvents
TmpDir = Dir(DrivePath, vbDirectory)
Do While TmpDir <> ""
  If TmpDir <> "." And TmpDir <> ".." Then
    If (GetAttr(DrivePath & TmpDir) And vbDirectory) = vbDirectory Then
      XDir(DirCount) = DrivePath & TmpDir & "\"
      DirCount = DirCount + 1
      ReDim Preserve XDir(DirCount) As String
    End If
  End If
  TmpDir = Dir
Loop
'Searches for the files given by extension Ext
FFound = Dir(DrivePath & Ext)
Do Until FFound = ""
  'Code in here for the actions of the files found.
  'Files found stored in the variable FFound.
  'Example: Form1.list1.AddItem DrivePath & FFound
  FFound = Dir
Loop
'Recursive searches through all sub directories
For X = 0 To (UBound(XDir) - 1)
  FilesSearch XDir(X), Ext
Next X
End Sub
Upload