Home Menu

Menu


ExcelBanter » Excel Newsgroups » Excel Programming > Application.FileSearch Help
Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 19
Default Application.FileSearch Help
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
Reply With QuoteReply With Quote
  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 9,101
Default 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
Reply With QuoteReply With Quote
  #3   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 9,101
Default Application.FileSearch Help
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("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
Reply With QuoteReply With Quote
Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes
Linear Mode Linear Mode

Posting Rules
Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On

Similar Threads
Thread Thread Starter Forum Replies Last Post
Application.FileSearch Cleberton(Brazilian) Excel Discussion (Misc queries) 2 October 26th 09 01:21 PM
What is better: Application.FileSearch or Dir ?? WhytheQ Excel Programming 9 October 25th 06 01:29 PM
Application.Filesearch EA Excel Programming 3 August 17th 06 10:07 AM
Application . filesearch doesn't work somethinglikeant Excel Programming 1 June 16th 06 06:42 PM
VBA Application.FileSearch Roger Frye Excel Programming 0 March 5th 04 04:07 AM


All times are GMT +1. The time now is 09:36 PM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"

 

Contact Us ExcelBanter forum home Privacy Statement