Application.FileSearch Help
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("Cre ation
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
|