'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
Private oMainFolder As Scripting.Folder
Private oFileCollection As Scripting.Files
Private oFile As Scripting.File

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

Public Sub GetAllFiles(FolderPath As String, Target As Range)
'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
        GetFileList oSubFolder.Path, Target
        GetAllFiles oSubFolder.Path, Target
    Next
End Sub
Public Sub ClearPreviousSearch(shtSheet As Worksheet)
shtSheet.UsedRange.EntireRow.Delete
lTargetOffset = 0
End Sub
Public Sub GetFileList(FolderToSearch As String, Target As Range)
'this will put a list of files on a spreadsheet at the Target, does not include files in subfolders

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

Set rgTarget = Target

Set oMainFolder = FSO.GetFolder(FolderToSearch)
Set oFileCollection = oMainFolder.Files
lRangeRow = Target.Row

For Each oFile In oFileCollection
    If Not InStr(CStr(oFile.Name), "b") Then
        Target.Offset(lTargetOffset, 0) = oFile.Path
        Target.Offset(lTargetOffset, 1) = oFile.Name
        lTargetOffset = lTargetOffset + 1
    End If
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

Sub Macro2()

Dim StrFldr As String
Dim ExtractCSV As Workbook
Dim ExtractCSVSheet As Worksheet
Dim lngWriteCol As Long
Dim Template As Workbook
Dim TemplateExtract As Worksheet
Dim LastRow As Long
Dim FromRow As Long
Dim FromFileName As String
Dim ToRow As Long
Dim TemplateList As Worksheet

Application.DisplayAlerts = False
Application.ScreenUpdating = False

Set Template = Application.Workbooks.Open("C:\Documents and Settings\SeymourJ\Desktop\Tasks\HondaExtractMacro\DealerData_Extract_Feed_Template.xls")
Set TemplateExtract = Template.Sheets("ExtractData")
Set TemplateList = Template.Sheets("Sheet1")

StrFldr = "C:\Documents and Settings\SeymourJ\Desktop\Test1\"

LastRow = TemplateList.Cells(Rows.Count, "C").End(xlUp).Row

lngWriteCol = 2

For FromRow = 1 To LastRow
    FromFileName = StrFldr & TemplateList.Cells(FromRow, "C").Value
    If Dir(FromFileName) > "" Then
    Set ExtractCSV = Workbooks.Open(FromFileName)
    Set ExtractCSVSheet = ExtractCSV.Worksheets(1)

    ExtractCSVSheet.Range("E2:E2000").Copy Destination:=TemplateExtract.Cells(3, lngWriteCol)
    
    ExtractCSV.Close
    
    lngWriteCol = lngWriteCol + 1
    End If
Next

End Sub

If Len(Dir(FromFileName)) > 0 Then