Dim FS As Office.FileSearch
Dim vaFileName as Variant
Dim i as Long
Dim stMessage as String
Dim iCount as Long

Set FS = Application.FileSearch

With FS

'Clear old search criteria
.NewSearch

'Directory to search
.Lookin = "C:\MyFiles"

'Include subfolders in search
.SearchSubFolders = True

'Look for excel files
.FileType = msoFileTypeExcelWorkbooks

'Doesn't matter when last modified
.LastModified = msoLastModifiedAnyTime

'Carry out the search and capture the number of files found
iCount = .Execute

stMessage = Format(iCount, "0 ""Files found""")

'List the files in the FoundFiles collection
For Each vaFileName in .FoundFiles
   stMessage = stMessage & vbCr & vaFileName
Next vaFileName

MsgBox stMessage

End With

.FileName = "*.xls"

Sub Get_Dealer_Count()

'********************************************************************
'Opens the extract size checker document
'Loops through the Dealerdata folder
'Takes a count of all files in the folder
'Places the result into the extract size checker document
'JS - 17/01/2011
'********************************************************************

'Define Variables
    'Const strFldr As String = "Path2"
    Dim strTemplate As String
    Dim strFldr As String
    Dim strFile As String
    Dim FS  As Office.FileSearch
    Dim wbExtractSize As Workbook
    Dim wbCsv As Workbook
    Dim wsDealerExtracts As Worksheet
    Dim wsMyCsvSheet As Worksheet
    Dim lNextRow As Long

'set strFldr variables
    strFldr = "C:\Production2\ATX\Extracts\201001\"

'set strFile variables
    strFile = Dir(strFldr & "\*.csv")

'set the calculation mode
    Application.Calculation = xlCalculationManual

'set the workbook and worksheet
    Set wbExtractSize = Workbooks.Open("C:\Documents and Settings\SeymourJ\Desktop\Tasks\MacroTask\Extract_Size_Checker_test.xls")
    Set wsDealerExtracts = wbExtractSize.Sheets("Dealer Extracts")

'find the next row available in ExtractSize, add two to
    lNextRow = 18
   
'Loop through the csv files
    Set FS = Application.FileSearch
    With FS
    .NewSearch
    .SearchSubFolders = True
    .LastModified = msoLastModifiedAnyTime
    If Len(strFldr) > 0 Then
        Do
            Set wbCsv = Workbooks.Open(Filename:=strFldr & "\" & strFile)
            Set wsMyCsvSheet = wbCsv.Sheets(1)
            With wsDealerExtracts
                .Cells(lNextRow, 6) = strFldr
                .Cells(lNextRow, 7) = strFile
                .Cells(lNextRow, 8) = WorksheetFunction.CountA(wsMyCsvSheet.Range("A:A"))
            End With
        
        'increment to the next row
            lNextRow = lNextRow + 1
        
        'close it
            wbCsv.Close
        
        'go to next file
            strFile = Dir
            Application.StatusBar = strFile
        Loop Until Len(strFile) = 0
    End If
    End With
    
    ActiveWorkbook.ActiveSheet.Range("A1").Select
    
'clean up
    Set wbExtractSize = Nothing
    Set wbCsv = Nothing
    Set wsDealerExtracts = Nothing
    Set wsMyCsvSheet = Nothing

End Sub

'To use this class module in another workbook, you'll need to set a reference to the "microsoft scripting runtime" library
Option Explicit

Private FSO As Scripting.FileSystemObject

'For putting the file list into a worksheet
Private lTargetOffset As Long

Public Sub GetAllFiles(FolderPath As String, Target As Range) 'including those in sub folders
'gets all files in FolderPath, including those in subfolders
    Static oParentFolder As Scripting.Folder
    Static oSubFolder As Scripting.Folder
    Static oFolders As Scripting.Folders
    
    Set oParentFolder = FSO.GetFolder(FolderPath)
    Set oFolders = oParentFolder.SubFolders
    
    GetFileList FolderPath, Target
    
    If oFolders.Count = 0 Then 'there's no subfolders in this folder
        Exit Sub
    End If
    
    For Each oSubFolder In oFolders
        GetAllFiles oSubFolder.Path, Target
    Next
End Sub
Public Sub ClearPreviousSearch(shtSheet As Worksheet)
shtSheet.UsedRange.Offset(1, 0).EntireRow.Delete
lTargetOffset = 0
End Sub
Public Sub GetFileList(FolderToSearch As String, Target As Range) 'in current folder only, no sub folders
'this will put a list of files on a spreadsheet at the Target, does not include files in subfolders

Static oMainFolder As Scripting.Folder
Static oFileCollection As Scripting.Files
Static oFile As Scripting.File

'Put a trailing backslash on path if it's not there
If Right(FolderToSearch, 1) <> "\" Then
    FolderToSearch = FolderToSearch & "\"
End If

Set oMainFolder = FSO.GetFolder(FolderToSearch)
Set oFileCollection = oMainFolder.Files

For Each oFile In oFileCollection
'    'here's a few other properties you can return
'    oFile.Path
'    oFile.DateCreated
'    oFile.DateLastModified

'    'and a method
'    oFile.Delete
    Target.Offset(lTargetOffset, 0) = oFile.Path
    Target.Offset(lTargetOffset, 1) = oFile.Name
    lTargetOffset = lTargetOffset + 1
Next oFile

End Sub

Private Sub Class_Initialize()
Set FSO = New Scripting.FileSystemObject
End Sub

Private Sub Class_Terminate()
Set FSO = Nothing
End Sub

Dim FH As New clsFileHandler
FH.ClearPreviousSearch shtFiles
FH.GetAllFiles "C:\Users\Mike\Documents\Business\StatsCustomers1\CustomerWebsites\elizabethsloomroom", shtFiles.Range("A2")
Set FH = Nothing

 FH As New clsFileHandler

Dim FH As New clsFileHandler

'not
FH As New clsFileHandler

 FSO As Scripting.FileSystemObject