Open only files last modified in SubDir

[GregR]

I have this code courtesy of Ron De Bruin:

Sub FSO_Example_1()
Dim SubFolders As Boolean
Dim Fsbj As Object, RootFolder As Object
Dim SubFolderInRoot As Object, file As Object
Dim RootPath As String, FileExt As String
Dim MyFiles() As String, Fnum As Long
Dim rng As Range, str As String
Dim rnum As Long
Dim basebook As Workbook, mybook As Workbook

'Loop through all files in the Root folder
RootPath = "C:\Documents and Settings\GregR\My documents\Recons"
'Loop through the subfolders True or False
SubFolders = True
'Loop through files with this extension
FileExt = ".xls"

'Add a slash at the end if the user forget it
If Right(RootPath, 1) <> "\" Then
RootPath = RootPath & "\"
End If

Set Fsbj = CreateObject("Scripting.FileSystemObject")
If Not Fsbj.FolderExists(RootPath) Then
MsgBox RootPath & " Not exist"
Exit Sub
End If

Set RootFolder = Fsbj.GetFolder(RootPath)

'Fill the array(myFiles)with the list of Excel files in the
folder(s)
Fnum = 0
'Loop through the files in the RootFolder
For Each file In RootFolder.Files
If LCase(Right(file.Name, 4)) = FileExt Then
Fnum = Fnum + 1
ReDim Preserve MyFiles(1 To Fnum)
MyFiles(Fnum) = RootPath & file.Name
End If
Next file

'Loop through the files in the Sub Folders if SubFolders = True
If SubFolders Then
For Each SubFolderInRoot In RootFolder.SubFolders
For Each file In SubFolderInRoot.Files
If LCase(Right(file.Name, 4)) = FileExt Then
Fnum = Fnum + 1
ReDim Preserve MyFiles(1 To Fnum)
MyFiles(Fnum) = SubFolderInRoot & "\" & file.Name
End If
Next file
Next SubFolderInRoot
End If

' Now we can open the files in the array MyFiles to do what we want
'******************************************************************

On Error GoTo CleanUp
Application.ScreenUpdating = False

Set basebook = ThisWorkbook
str = Sheets("Sheet3").ComboBox1.Value

'Clear all cells on the first sheet
basebook.Worksheets(1).Cells.Clear

'Loop through all files in the array(myFiles)
If Fnum > 0 Then
For Fnum = LBound(MyFiles) To UBound(MyFiles)
Set mybook = Workbooks.Open(MyFiles(Fnum))
rnum = LastRow(basebook.Worksheets("Sheet2")) + 1

With mybook.Sheets(1)
Set rng = Nothing

'Close AutoFilter first
.AutoFilterMode = False

'This example filter on column A for ron, Note: A1 is
the Header cell
'Change the range and criteria to your Range/Criteria
.Range("B8:B400").AutoFilter Field:=1, Criteria1:=str

With .AutoFilter.Range

' Set a range without the Header cell
On Error Resume Next
Set rng = .Offset(1, 0).Resize(.Rows.Count - 1, 1)
_
.SpecialCells(xlCellTypeVisible)
On Error GoTo 0

'If there is data copy the rows
If Not rng Is Nothing Then
rng.EntireRow.Copy
basebook.Worksheets("Sheet2").Cells(rnum, "A")
End If

End With

'Close AutoFilter
.AutoFilterMode = False

End With

mybook.Close savechanges:=False
Next Fnum
End If
CleanUp:
Application.ScreenUpdating = True
End Sub
I want to use this code to create a summary project book. I want to
modify the code to only open the last modified file in each SubDir,
copy Sheet(1) from each file to a new summary book, rename the sheet to
the left 6 characters of the SubDir and close the files. The expected
result would be a summary book containing the last modified project
sheet for each project. Each project is a SubDir. I need help. TIA

Greg