Consolidating Folders/Subfolders/Subsubfolders containing excel files

Hi,

I have two pieces of code below. The first code copy files from one folder to another that contain the .xls extension, but not ALL excel files within sub folders and sub sub folders (how many levels deep, is unknown.). The second piece of code pulls excel files from one folder to another folder based on datelastmodified.

So my task and question involves three matters.

1. How to combine both procedures so that user selected dates would search for only excel files in all folders and subfolders etc. and then copy them into a new filepath destination.
2. How would I modify my code to do this?
3. What recursive or iterative embedded code would do this while combining both of my procedures together?

C:\Carl\Smith\ ----- First sub frompath
C:\Carl\Smith\Tim\ ------First sub topath and second sub topath
C:\Carl\Smith\Tim\Free ------Second sub topath

----------------------------------------------------------------------------------------------------------------------------------

Private Sub Retrieve_Click()

'This procedure will copy all Excel files from FromPath to ToPath.
'Note: If the files in ToPath already exist it will overwrite
'existing files in this folder
Dim FSO As Object
Dim FromPath As String
Dim ToPath As String
Dim FileExt As String


FromPath = "C:\Carl\Smith" '<< Change
ToPath = "C:\Carl\Smith\Tim" '<< Change only the destination folder
FileExt = "*.xl*" '<< Change
'You can use *.* for all files or *.doc for word files

If Right(FromPath, 1) <> "\" Then
FromPath = FromPath & "\"
End If

Set FSO = CreateObject("scripting.filesystemobject")

If FSO.FolderExists(FromPath) = False Then
MsgBox FromPath & " doesn't exist"
Exit Sub
End If

If FSO.FolderExists(ToPath) = False Then
MsgBox ToPath & " doesn't exist"
Exit Sub
End If

FSO.CopyFile Source:=FromPath & FileExt, Destination:=ToPath
MsgBox "You can find the files from " & FromPath & " in " & ToPath

On Error Resume Next
Kill "C:\Carl\Smith\Tim\*.doc*"
Kill "C:\Carl\Smith\Tim\*.pdf*"
Kill "C:\Carl\Smith\Tim\*.rtf*"
Kill "C:\Carl\Smith\Tim\*.msg*"
Kill "C:\Carl\Smith\Tim\*.tmp*"
On Error GoTo 0


End Sub


Private Sub cmdRun_Click()

'This example copy all files between certain dates from FromPath to ToPath.
'You can also use this to copy the files from the last ? days
'If Fdate >= Date - 30 Then
'Note: If the files in ToPath already exist it will overwrite
'existing files in this folder
Dim FSO As Object
Dim FromPath As String
Dim ToPath As String
Dim Fdate As Date
Dim FileInFromFolder As Object

FromPath = "C:\Carl\Smith\Tim" '<< Change
ToPath = "C:\Carl\Smith\Tim\Free" '<< Change

If Right(FromPath, 1) <> "\" Then
FromPath = FromPath & "\"
End If

If Right(ToPath, 1) <> "\" Then
ToPath = ToPath & "\"
End If

Set FSO = CreateObject("scripting.filesystemobject")

If FSO.FolderExists(FromPath) = False Then
MsgBox FromPath & " doesn't exist"
Exit Sub
End If

If FSO.FolderExists(ToPath) = False Then
MsgBox ToPath & " doesn't exist"
Exit Sub
End If

For Each FileInFromFolder In FSO.GetFolder(FromPath).Files
Fdate = Int(FileInFromFolder.DateLastModified)
'Copy files from 1-Oct-2006 to 1-Nov-2006' From DateSerial(2006, 10, 1) ' To DateSerial(2013, 1, 4)
If Fdate >= Me.txtFROMDATE.Value And Fdate <= Me.txtTODATE.Value Then
FileInFromFolder.Copy ToPath
End If
Next FileInFromFolder

On Error Resume Next
Kill "C:\Carl\Smith\Tim\Free\*.doc*"
Kill "C:\Carl\Smith\Tim\Free\*.pdf*"
Kill "C:\Carl\Smith\Tim\Free\*.rtf*"
Kill "C:\Carl\Smith\Tim\Free\*.msg*"
Kill "C:\Carl\Smith\Tim\Free\*.tmp*"
On Error GoTo 0

MsgBox "You can find the files from " & FromPath & " in " & ToPath

End Sub


Thanks for any help....