Two months copying and experimenting with the below code, It works; but will
not work in 2007. Would anyone be able to help me revise the code with DIR or
FileSystemObject?

The code searches a directory and all subs for files with particular text
("StsRpt") in its name - example files: StsRpt_042008.xls and
StsRpt_042108.xls. Then it selects the latest file saved/modified. Finally it
places all files found in a ascending order. Any help would be welcomed.

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 = Left(fs.Getfilename(.FoundFiles(i)), 14)
'Created = FileDate(WFD.ftCreationTime)

'MsgBox ActiveWorkbook.BuiltinDocumentProperties.Item("Creation
date").Value


'FullName = ActiveWorkbook.FullName
FullName = myfile
hFile = FindFirstFile(FullName, WFD)

FileDates(i, 0) = jj.Name
FileDates(i, 1) = xxx 'myfile.Getfilename(myfile.Name)
FileDates(i, 2) = i 'keep index number to use after sort
FileDates(i, 3) = False 'boolean indicating if latest
FileDates(i, 4) = FileDate(WFD.ftCreationTime)
'fs.getfile (FileDate(WFD.ftCreationTime))

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, 0)
FileDates(i, 0) = FileDates(J, 0)
FileDates(J, 0) = TEMP

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 date newest to oldest
For i = 1 To (newestfile - 1)
For J = (i + 1) To newestfile
If (FileDates(J, 1) = FileDates(i, 1)) And (FileDates(J, 4) >
FileDates(i, 4)) Then
TEMP = FileDates(i, 0)
FileDates(i, 0) = FileDates(J, 0)
FileDates(J, 0) = TEMP

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, 3) = True
For i = 2 To newestfile
If FileDates(i, 1) <> FileDates(i - 1, 1) Then
FileDates(i, 3) = 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
Next i
End If
End With

--
PK

try this change

Dim FileDates(100, 4) As Variant

y = "*.xls"
fLdir = "c:\temp"

Set fso = CreateObject _
("Scripting.FileSystemObject")

First = True
newestfile = 0
Do
If First = True Then
FName = Dir(fLdir & "\" & y)
First = False
Else
FName = Dir()
End If
If FName <> "" Then

Set MyFile = fso.GetFile(fLdir & "\" & FName)
FileDates(FileCount, 0) = FName
FileDates(FileCount, 1) = MyFile
FileDates(FileCount, 2) = FileCount
FileDates(FileCount, 3) = False
FileDates(FileCount, 4) = MyFiles1.Datecreated
newestfile = newestfile + 1
End If
Loop While FName <> ""



Set ws = ThisWorkbook.Worksheets("Dashboard")

'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, 0)
FileDates(i, 0) = FileDates(J, 0)
FileDates(J, 0) = temp

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 date newest to oldest
For i = 1 To (newestfile - 1)
For J = (i + 1) To newestfile
If (FileDates(J, 1) = FileDates(i, 1)) And _
(FileDates(J, 4) > FileDates(i, 4)) Then
temp = FileDates(i, 0)
FileDates(i, 0) = FileDates(J, 0)
FileDates(J, 0) = temp

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, 3) = True
For i = 2 To newestfile
If FileDates(i, 1) <> FileDates(i - 1, 1) Then
FileDates(i, 3) = 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
Next i
End If
End With

"Patrick Kirk" wrote:

> Two months copying and experimenting with the below code, It works; but will
> not work in 2007. Would anyone be able to help me revise the code with DIR or
> FileSystemObject?
>
> The code searches a directory and all subs for files with particular text
> ("StsRpt") in its name - example files: StsRpt_042008.xls and
> StsRpt_042108.xls. Then it selects the latest file saved/modified. Finally it
> places all files found in a ascending order. Any help would be welcomed.
>
> 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 = Left(fs.Getfilename(.FoundFiles(i)), 14)
> 'Created = FileDate(WFD.ftCreationTime)
>
> 'MsgBox ActiveWorkbook.BuiltinDocumentProperties.Item("Creation
> date").Value
>
>
> 'FullName = ActiveWorkbook.FullName
> FullName = myfile
> hFile = FindFirstFile(FullName, WFD)
>
> FileDates(i, 0) = jj.Name
> FileDates(i, 1) = xxx 'myfile.Getfilename(myfile.Name)
> FileDates(i, 2) = i 'keep index number to use after sort
> FileDates(i, 3) = False 'boolean indicating if latest
> FileDates(i, 4) = FileDate(WFD.ftCreationTime)
> 'fs.getfile (FileDate(WFD.ftCreationTime))
>
> 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, 0)
> FileDates(i, 0) = FileDates(J, 0)
> FileDates(J, 0) = TEMP
>
> 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 date newest to oldest
> For i = 1 To (newestfile - 1)
> For J = (i + 1) To newestfile
> If (FileDates(J, 1) = FileDates(i, 1)) And (FileDates(J, 4) >
> FileDates(i, 4)) Then
> TEMP = FileDates(i, 0)
> FileDates(i, 0) = FileDates(J, 0)
> FileDates(J, 0) = TEMP
>
> 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, 3) = True
> For i = 2 To newestfile
> If FileDates(i, 1) <> FileDates(i - 1, 1) Then
> FileDates(i, 3) = 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
> Next i
> End If
> End With
>
> --
> PK

I just noticed a slight problem. i start putting data in the array starting
at index 0. You sort code starts sorting at 1. Something need to change

from
For i = 1 To (newestfile - 1)
For J = (i + 1) To newestfile
to
For i = 0 To (newestfile - 2)
For J = (i + 1) To (newestfile - 1)


"Joel" wrote:

> try this change
>
> Dim FileDates(100, 4) As Variant
>
> y = "*.xls"
> fLdir = "c:\temp"
>
> Set fso = CreateObject _
> ("Scripting.FileSystemObject")
>
> First = True
> newestfile = 0
> Do
> If First = True Then
> FName = Dir(fLdir & "\" & y)
> First = False
> Else
> FName = Dir()
> End If
> If FName <> "" Then
>
> Set MyFile = fso.GetFile(fLdir & "\" & FName)
> FileDates(FileCount, 0) = FName
> FileDates(FileCount, 1) = MyFile
> FileDates(FileCount, 2) = FileCount
> FileDates(FileCount, 3) = False
> FileDates(FileCount, 4) = MyFiles1.Datecreated
> newestfile = newestfile + 1
> End If
> Loop While FName <> ""
>
>
>
> Set ws = ThisWorkbook.Worksheets("Dashboard")
>
> '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, 0)
> FileDates(i, 0) = FileDates(J, 0)
> FileDates(J, 0) = temp
>
> 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 date newest to oldest
> For i = 1 To (newestfile - 1)
> For J = (i + 1) To newestfile
> If (FileDates(J, 1) = FileDates(i, 1)) And _
> (FileDates(J, 4) > FileDates(i, 4)) Then
> temp = FileDates(i, 0)
> FileDates(i, 0) = FileDates(J, 0)
> FileDates(J, 0) = temp
>
> 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, 3) = True
> For i = 2 To newestfile
> If FileDates(i, 1) <> FileDates(i - 1, 1) Then
> FileDates(i, 3) = 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
> Next i
> End If
> End With
>
> "Patrick Kirk" wrote:
>
> > Two months copying and experimenting with the below code, It works; but will
> > not work in 2007. Would anyone be able to help me revise the code with DIR or
> > FileSystemObject?
> >
> > The code searches a directory and all subs for files with particular text
> > ("StsRpt") in its name - example files: StsRpt_042008.xls and
> > StsRpt_042108.xls. Then it selects the latest file saved/modified. Finally it
> > places all files found in a ascending order. Any help would be welcomed.
> >
> > 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 = Left(fs.Getfilename(.FoundFiles(i)), 14)
> > 'Created = FileDate(WFD.ftCreationTime)
> >
> > 'MsgBox ActiveWorkbook.BuiltinDocumentProperties.Item("Creation
> > date").Value
> >
> >
> > 'FullName = ActiveWorkbook.FullName
> > FullName = myfile
> > hFile = FindFirstFile(FullName, WFD)
> >
> > FileDates(i, 0) = jj.Name
> > FileDates(i, 1) = xxx 'myfile.Getfilename(myfile.Name)
> > FileDates(i, 2) = i 'keep index number to use after sort
> > FileDates(i, 3) = False 'boolean indicating if latest
> > FileDates(i, 4) = FileDate(WFD.ftCreationTime)
> > 'fs.getfile (FileDate(WFD.ftCreationTime))
> >
> > 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, 0)
> > FileDates(i, 0) = FileDates(J, 0)
> > FileDates(J, 0) = TEMP
> >
> > 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 date newest to oldest
> > For i = 1 To (newestfile - 1)
> > For J = (i + 1) To newestfile
> > If (FileDates(J, 1) = FileDates(i, 1)) And (FileDates(J, 4) >
> > FileDates(i, 4)) Then
> > TEMP = FileDates(i, 0)
> > FileDates(i, 0) = FileDates(J, 0)
> > FileDates(J, 0) = TEMP
> >
> > 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, 3) = True
> > For i = 2 To newestfile
> > If FileDates(i, 1) <> FileDates(i - 1, 1) Then
> > FileDates(i, 3) = 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
> > Next i
> > End If
> > End With
> >
> > --
> > PK