I have bads news for you. FileSearch isn't available in Excel 2007 (that is
what people have told me). some people claim filesearch also doesn't work
under some conditions (large searches). Here is code that does the
equivalent to FileSearch if you arre interested in looking at this code. It
perform a recusive search of all the subdirectories.


Sub getfiles()


Set fso = CreateObject _
("Scripting.FileSystemObject")
Set folder = _
fso.GetFolder("C:\temp\")

If folder.subfolders.Count 0 Then
For Each sf In folder.subfolders

Set fso1 = CreateObject _
("Scripting.FileSystemObject")
Set folder1 = _
fso1.GetFolder(sf)
If folder1.Files.Count 0 Then
For Each file In folder1.Files

'add code to open each file here.
Next file
End If

Next sf
End If

End Sub
Sub getfiles()


Set fso = CreateObject _
("Scripting.FileSystemObject")
Set folder = _
fso.GetFolder("C:\temp\")

If folder.subfolders.Count 0 Then
For Each sf In folder.subfolders
If InStr(sf, "Agent") Then

Set fso1 = CreateObject _
("Scripting.FileSystemObject")
Set folder1 = _
fso1.GetFolder(sf)
If folder1.Files.Count 0 Then
For Each file In folder1.Files

'add code to open each file here.
Next file
End If
End If
Next sf
End If

End Sub


"Patrick Kirk" wrote:

Joel,

I think Im missing something here. Im still receiving the same output. I've
followed the array as much as I can with my limited knowledge of VBA but
couldn't find where the code actually determines the latest instance of a
file.

If Im not mistaken, it appears if the array object #4 is true, then the
contents of the array is written. I also made a modification to the code
referencing the Getfile and Getfilename methods. What are your thoughts?

Sub SrchForFiles()

Dim i As Long, z As Long, Rw As Long
Dim sReport As Workbook, sDashboard As Workbook
Dim ws As Worksheet, pat As Workbook
Dim sRpt As Object, dPt As Object
Dim y As Variant
Dim fLdr As String, Fil As String, FPath As String, x As String, _
pname As String, NumFound As String
Dim FileDates As Variant

Set fs = CreateObject("Scripting.FileSystemObject")

Wks_delete ' Delete old worksheets
ClearContents

y = "Sts*.xls"
If y = False And Not TypeName(y) = "String" Then Exit Sub
Application.ScreenUpdating = False
fLdr = DirPath '.SelectedItems(1)
Set sDashboard = ThisWorkbook

With Application.FileSearch
.NewSearch
.LookIn = fLdr
.SearchSubFolders = True
.FileName = y
Set ws = ThisWorkbook.Worksheets("Dashboard")
On Error GoTo 1
2:
On Error GoTo 0
NumFound = .Execute(msoSortByLastModified, msoSortOrderAscending, _
True)
If NumFound 0 Then
NewestFile = .FoundFiles.Count 'NewestFile = FilesFound(1)
ReDim FileDates(NewestFile, 4)
'get array to sort
For i = 1 To NewestFile
myfile = fs.getfile(.FoundFiles(i))
Set jj = fs.getfile(.FoundFiles(i))
xxx = fs.Getfilename(.FoundFiles(i))
FileDates(i, 1) = jj.Datecreated
FileDates(i, 2) = xxx 'myfile.Getfilename(myfile.Name)
FileDates(i, 3) = i 'keep index number to use after sort
FileDates(i, 4) = False 'boolean indicating if latest
Next i
'sort by date newest to oldest
For i = 1 To (NewestFile - 1)
For j = (i + 1) To NewestFile
If FileDates(j, 1) FileDates(i, 1) Then
temp = FileDates(i, 1)
FileDates(i, 1) = FileDates(j, 1)
FileDates(j, 1) = temp

temp = FileDates(i, 2)
FileDates(i, 2) = FileDates(j, 2)
FileDates(j, 2) = temp

temp = FileDates(i, 3)
FileDates(i, 3) = FileDates(j, 3)
FileDates(j, 3) = temp

temp = FileDates(i, 4)
FileDates(i, 4) = FileDates(j, 4)
FileDates(j, 4) = temp

End If
Next j
Next i

'sort by filename
For i = 1 To (NewestFile - 1)
For j = (i + 1) To NewestFile
If FileDates(j, 1) FileDates(i, 1) Then
temp = FileDates(i, 1)
FileDates(i, 1) = FileDates(j, 1)
FileDates(j, 1) = temp

temp = FileDates(i, 2)
FileDates(i, 2) = FileDates(j, 2)
FileDates(j, 2) = temp

temp = FileDates(i, 3)
FileDates(i, 3) = FileDates(j, 3)
FileDates(j, 3) = temp

temp = FileDates(i, 4)
FileDates(i, 4) = FileDates(j, 4)
FileDates(j, 4) = temp

End If
Next j
Next i

'determine latest file
'first entry is always the latest
FileDates(1, 4) = True
For i = 2 To NewestFile
If FileDates(i, 2) < FileDates(i - 1, 2) Then
FileDates(i, 4) = True
End If
Next
'the latest files are the ones with True in index 4
'index 3 is the index number in foundfiles

For i = 1 To NewestFile
' NewestFile = .FoundFiles(1)
' 'Fil = .FoundFiles(i)
' Fil = NewestFile
'Get file path from file name
' FPath = Left(Fil, Len(Fil) - Len(Split(Fil, _
'"\")(UBound(Split(Fil, "\")))) - 1)

' If Left$(Fil, 1) = Left$(fLdr, 1) Then
' If CBool(Len(Dir(Fil))) Then
' x = (Array(Dir(Fil))(0))
' End If
If FileDates(i, 4) = True Then
Set sReport = Workbooks.Open(.FoundFiles(FileDates(i,
3)), UpdateLinks:=0)

' DelFormula

sReport.Worksheets(1).Copy _
After:=sDashboard.Sheets(sDashboard.Sheets.Count)
ActiveSheet.Name = sReport.Name & "(" & i & ")"

If FileDates(i, 3) = 1 Then
z = 7
Else
z = z + 1
End If
Worksheets("Dashboard").Range("A" & z).Value = _
Worksheets(ActiveSheet.Name).Range("staPrgNum").Va lue
Worksheets("Dashboard").Range("B" & z).Value = _
Worksheets(ActiveSheet.Name).Range("staPrgName").V alue
Worksheets("Dashboard").Range("C" & z).Value = _
Worksheets(ActiveSheet.Name).Range("staPrgMgr").Va lue
Worksheets("Dashboard").Range("D" & z).Value = _
Worksheets(ActiveSheet.Name).Range("staDelDate").V alue
Worksheets("Dashboard").Range("F" & z).Value = _
Worksheets(ActiveSheet.Name).Range("TotVariance"). Value
Worksheets("Dashboard").Range("G" & z).Value = _
Worksheets(ActiveSheet.Name).Range("CompPct").Valu e
Worksheets("Dashboard").Range("Q" & z).Value = _
Worksheets(ActiveSheet.Name).Range("CompPct").Valu e
sReport.Close SaveChanges = False
Worksheets(ActiveSheet.Name).Select
Worksheets(ActiveSheet.Name).Visible = False
Sheets("Dashboard").Select
ws.Hyperlinks.Add Range("a" & z), Address:="", _
SubAddress:="Dashboard!A" & z
End If
Next i
End If
End With

ActiveWindow.DisplayHeadings = False
Application.ScreenUpdating = True
Exit Sub
1: Application.DisplayAlerts = False
Worksheets("FileSearch Results").Delete
Application.DisplayAlerts = True
GoTo 2
End Sub



--
PK


"Joel" wrote:

My original code was not complete. It was just to get you started. I made a
few more changes, see if this helps

Sub SrchForFiles()

Dim i As Long, z As Long, Rw As Long
Dim sReport As Workbook, sDashboard As Workbook
Dim ws As Worksheet, pat As Workbook
Dim sRpt As Object, dPt As Object
Dim y As Variant
Dim fLdr As String, Fil As String, FPath As String, x As String, _
pname As String, NumFound As String
Dim FileDates As Variant

Set fs = CreateObject("Scripting.FileSystemObject")

Wks_delete ' Delete old worksheets
ClearContents

y = "Sts*.xls"
If y = False And Not TypeName(y) = "String" Then Exit Sub
Application.ScreenUpdating = False
fLdr = dirPath '.SelectedItems(1)
Set sDashboard = ThisWorkbook

With Application.FileSearch
.NewSearch
.LookIn = fLdr
.SearchSubFolders = True
.Filename = y
Set ws = ThisWorkbook.Worksheets("Dashboard")
On Error GoTo 1
2:
On Error GoTo 0
NumFound = .Execute(msoSortByLastModified, msoSortOrderAscending, _
True)
If NumFound 0 Then
NewestFile = .FoundFiles.Count 'NewestFile = FilesFound(1)
ReDim FileDates(NewestFile, 4)
'get array to sort
For i = 1 To NewestFiles
Myfile = fs.GetFile(.FoundFiles(i))
FileDates(i, 1) = Myfile.Date
FileDates(i, 2) = Myfile.getfilename(Myfile.Name)
FileDates(i, 3) = i 'keep index number to use after sort
FileDates(i, 4) = False 'boolean indicating if latest
Next i
'sort by date newest to oldest
For i = 1 To (NewestFiles - 1)
For j = (i + 1) To NewestFiles
If FileDates(j, 1) FileDates(i, 1) Then
temp = FileDates(i, 1)
FileDates(i, 1) = FileDates(j, 1)
FileDates(j, 1) = temp

temp = FileDates(i, 2)
FileDates(i, 2) = FileDates(j, 2)
FileDates(j, 2) = temp

temp = FileDates(i, 3)
FileDates(i, 3) = FileDates(j, 3)
FileDates(j, 3) = temp

temp = FileDates(i, 4)
FileDates(i, 4) = FileDates(j, 4)
FileDates(j, 4) = temp

End If
Next j
Next i

'sort by filename
For i = 1 To (NewestFiles - 1)
For j = (i + 1) To NewestFiles
If FileDates(j, 1) FileDates(i, 1) Then
temp = FileDates(i, 1)
FileDates(i, 1) = FileDates(j, 1)
FileDates(j, 1) = temp

temp = FileDates(i, 2)
FileDates(i, 2) = FileDates(j, 2)
FileDates(j, 2) = temp

temp = FileDates(i, 3)
FileDates(i, 3) = FileDates(j, 3)
FileDates(j, 3) = temp

temp = FileDates(i, 4)
FileDates(i, 4) = FileDates(j, 4)
FileDates(j, 4) = temp

End If
Next j
Next i

'determine latest file
'first entry is always the latest
FileDates(1, 4) = True
For i = 2 To NewestFiles
If FileDates(i, 2) < FileDates(i - 1, 2) Then
FileDates(i, 4) = True
End If
Next
'the latest files are the ones with True in index 4
'index 3 is the index number in foundfiles

For i = 1 To NewestFile
' NewestFile = .FoundFiles(1)
' 'Fil = .FoundFiles(i)
' Fil = NewestFile
'Get file path from file name
' FPath = Left(Fil, Len(Fil) - Len(Split(Fil, _
'"\")(UBound(Split(Fil, "\")))) - 1)

' If Left$(Fil, 1) = Left$(fLdr, 1) Then