The answere to all the questions about the functions Filesearch and
Foldersearch (where,why, what ect') is simp;e.
Up to the VBA Help topic "What new",those two functions are "Hidden" in 2007
version. What "Hidden" means? in this case vanished, probably as a result of
the changes in Vista search and document's ditails.
If your tired from looking ,here is three codes that do the same work, if
not better.
Public Creat, ErrMsg, Filename, Foldername, Filetype, Lookin, MatchFile,
Modify, SubFolders, Srch
Public Dayy As Date, FldrClc As New Collection, FoundFiles As New
Collection, Keyy As Integer
-----------------------------------------
Sub Search()
On Error GoTo sof
'Preparations
While FoundFiles.Count > 0
FoundFiles.Remove 1
Wend
If Right(Lookin, 1) <> "\" Then Lookin = Lookin & "\"
If Filename <> "" Then Foldername = "" Else Foldername =
Replace(Foldername, "\", "")
If Filename <> "" And InStr(Filename, ".") = 0 Then Filename = Filename
& ".*"
If Modify <> "" Then Creat = ""
If InStr(Creat & Modify, "=") > 0 Then If
IsDate(Replace(Replace(Right(Creat & Modify, Len(ICreat & Modify) -
InStr(Creat & Modify, "=")), "+", ""), "-", "")) = True Then _
Dayy = Replace(Replace(Right(Creat & Modify, Len(ICreat & Modify) -
InStr(Creat & Modify, "=")), "+", ""), "-", "") Else: If Creat = "" Then
Modify = Left(Modify, InStr _
(Modify, "=") - 1) Else Creat = Left(Creat, InStr(Creat, "=") - 1)
'Searching in Lookin
FindFile
If ErrMsg <> "" Or SubFolders = False Then GoTo sof
'Searching in SubFolders
Count = 1
While Count < FldrClc.Count + 1 And Ask <> 6
Lookin = FldrClc.Item(Count)
FindFile
If ErrMsg <> "" Then GoTo sof
Count = Count + 1
Wend
sof:
If Err > 0 Or ErrMsg <> "" Then
MsgBox ErrMsg
ElseIf IIf(Filename = "", FldrClc.Count, FoundFiles.Count) = 0 Then
MsgBox "There is no " & IIf(Filename = "", "Folder","File") & " suitable
to the search variabbles"
ElseIf Foldername <> "" Then
While FldrClc.Count > 0
Srch = Replace(Replace(FldrClc(1), Left(FldrClc(1),
InStrRev(Left(FldrClc(1), Len(FldrClc(1)) - 1), "\")), ""), "\", "")
If Srch = Foldername Or (InStr(Foldername, "*") <>
InStrRev(Foldername, "*") And InStr(Srch, Replace(Foldername, "*", "")) > 0)
Or (Replace(Foldername, "*", "") = _
IIf(Left(Foldername, 1) = "*", Right(Srch, Len(Foldername) - 1),
Left(Srch, Len(Foldername) - 1))) Then If Dayy = 0 Or IIf(InStr(Creat &
Modify, "-") = 0, IIf(Creat = "", _
CreateObject("Scripting.FileSystemObject").Getfolder(FldrClc(1)).DateLastModified,
CreateObject("Scripting.FileSystemObject").Getfolder(FldrClc(1)).DateCreated)
< _
Dayy, IIf(Creat = "",
CreateObject("Scripting.FileSystemObject").Getfolder(FldrClc(1)).DateLastModified, CreateObject("Scripting.FileSystemObject").Getfolder(FldrClc _
(1)).DateCreated) > Dayy) Then FoundFiles.Add
Item:=Replace(FldrClc(1), "\", "")
FldrClc.Remove 1
Wend
End If
Clean
End Sub
------------------------------------------------------
Sub FindFile()
On Error GoTo od
'Making SubFolders list
For Each Srch In
CreateObject("Scripting.FileSystemObject").Getfolder(Lookin).SubFolders
FldrClc.Add Item:=Lookin & Srch.Name & "\"
Next
If Foldername <> "" Then Exit Sub
MatchFile = Dir(Lookin & Filename)
While MatchFile <> ""
'Checking file name
If InStr(Filename, "*") = 0 And MatchFile <> Filename Then GoTo od
If InStr(Right(Filename, Len(Filename) - InStrRev(Filename, ".")), "*")
= 0 Then If Right(Filename, Len(Filename) - InStrRev(Filename, ".")) <>
Right(MatchFile, Len _
(MatchFile) - InStrRev(MatchFile, ".")) Then GoTo od
If Right(Filename, 1) <> "*" Then If Right(Filename, Len(Filename) -
WorksheetFunction.Max(InStrRev(Filename, "."), InStrRev(Filename, "*"))) <>
Right(MatchFile, Len _
(Filename) - WorksheetFunction.Max(InStrRev(Filename, "."),
InStrRev(Filename, "*"))) Then GoTo od
If Left(Filename, InStrRev(Filename, ".")) = 0 Then If Left(Filename,
InStrRev(Filename, ".")) <> Left(MatchFile, InStrRev(MatchFile, ".")) Then
GoTo od
If Left(Filename, 1) <> "*" Then If Left(Filename,
WorksheetFunction.Min(InStr(Filename, "*"), InStrRev(Filename, "."))) =
Left(MatchFile, WorksheetFunction.Min(InStr _
(Filename, "*"), InStrRev(Filename, "."))) Then GoTo od
'Checking filetype
If Filetype <> "" Then
With CreateObject("Scripting.FileSystemObject").GetFile(Lookin &
MatchFile)
If Left(Filetype, 1) = "*" And Right(Filetype, 1) = "*" Then
If InStr(.Type, Replace(Filetype, "*", "")) = 0 Then GoTo od
ElseIf Left(Filetype, 1) = "*" Then
If Right(.Type, Len(Filetype) - 1) <> Replace(Filetype,
"*", "") Then GoTo od
ElseIf Right(Filetype, 1) = "*" Then
If Left(.Type, Len(Filetype) - 1) <> Replace(Filetype, "*",
"") Then GoTo od
Else
If .Type <> Filetype Then GoTo od
End If
End With
End If
'Checking creat and modifiy dates
If Creat & Modify <> "" Then
With CreateObject("Scripting.FileSystemObject").GetFile(Lookin &
MatchFile)
If IIf(InStr(Creat & Modify, "-") = 0, IIf(Creat = "",
..DateCreated, .DateLastModified) < Dayy, IIf(Creat = "", .DateCreated,
..DateLastModified) > Dayy) Then GoTo od
MatchFile = MatchFile & IIf(Creat = "", Chr(10) & "Modified: ",
Chr(10) & "Created: ") & Trim(IIf(Creat = "", .DateCreated,
..DateLastModified))
'Replacing first\last created\modified file
If InStr(Creat & Modify, "=") = 0 Then
Dayy = IIf(Creat = "", .DateCreated, .DateLastModified)
If FoundFiles.Count > 0 Then FoundFiles.Remove 1
Else
Keyy = FoundFiles.Count
End If
'Sorting by created\modified dates
Do While Keyy > 0
If IIf(InStr(Creat & Modify, "Last") = 0, IIf(Creat = "",
..DateCreated, .DateLastModified) < CDate(Right(FoundFiles("K" & Keyy),
Len(FoundFiles("K" & Keyy)) - _
InStr(FoundFiles("K" & Keyy), ": "))), IIf(Creat = "",
..DateCreated, .DateLastModified) > CDate(Right(FoundFiles("K" & Keyy),
Len(FoundFiles("K" & Keyy)) - _
InStr(FoundFiles("K" & Keyy), ": ")))) Then
FoundFiles.Add Item:=FoundFiles("K" & Keyy), Key:="K" &
Keyy + 1
FoundFiles.Remove "K" & Keyy
Keyy = Keyy - 1
Else
Exit Do
End If
Loop
If InStr(Creat & Modify, "=") > 0 Then Keyy = Keyy + 1
End With
End If
'Adding match file to files collection
FoundFiles.Add Item:=Lookin & MatchFile, Key:="K" & IIf(Keyy = 0,
FoundFiles.Count + 1, Keyy)
od:
If Err > 0 Then
ErrMsg = "Misdefined search variables, The Search was stoped!"
Exit Sub
End If
MatchFile = Dir
Wend
End Sub
---------------------------------------------
Sub Clean()
Creat = ""
ErrMsg = ""
Filename = ""
Lookin = ""
Foldername = ""
Filetype = ""
MatchFile = ""
Modify = ""
Srch = ""
SubFolders = False
Title = ""
Keyy = 0
Dayy = 0
While FldrClc.Count > 0
FldrClc.Remove 1
Wend
End Sub
I 'm using it as three separt codes, parts of selfe-made Addin which hold
other functions and prorecdures, some of them use 'Clean' or\and 'FindFile'.
To unit it to one code paste 'FindFile' code, instead of the command
"FindFile", in 'Search' sub (twice) and do the same with 'Clean' code (once).
To understand the codes, go after the codes remarks, notice the meanings of
the references names: 'od' and 'sof'. In Hebrew: 'sof' means end and 'od'
means more (next).
Search ,as one or three codes (subs), can be used in the Module which use
it, as a separt Module in the same VBA Project (Workbook) and allso in other
VBA Project (Workbook), as your "Prsonal.xlsb" or AddIn.
To save Search in "Prsonal.xlsb" or Addin, open a new workbook (If you
allredy have "Prsonal.xlsb" it's olredy opened), creat a new Macro (in the
right Workbook), open it and past Search code.
If you allredy have "Prsonal.xlsb", save it from VBA project, if not save
the new Workbook as "Prsonal.xlsb" or AddIn ("*.xla"). In Both cases saved it
in "C:\Users\[user nmae]\AppData\Roaming\Microsoft\", "\Prsonal.xlsb" in
"Excel\XLSTART" AddIn in "\AddIns".
"Prsonal.xlsb" open itselef when ever you open Excel, AddIn you have to add
to the Addins list (Excel main menu). In both cases you had to connect Search
to every Project which uses it (VBA menue, "Tools\References").
Search variables:
Lookin: the drive and folder to search, e.g: "F:\Batata\"
SubFolders=[True\False]: True = searching sub folders and if omited the
default is False.
Filename: the file name with or without wildcards (*) , e.g:
"*Grenn*Vegitalbes*.xls*".
Foldername: the folder name with up to two wildcards (*), as the first and
last letters, e.g: "*Vegitalbes*"
Creat=["(First\Last)"] ["=(+\-){date}"] : file's created, "+" = from {date}
forward "-" = from {date} backward , "First" = sorted ascanding "Last" =
sorted descanding.
If {date} is omited Search will look for "First"= the first
created file, "Last" = the last created file.
e.g: "Last=-1/1/07" = from 1/1/07 backward sorted descanding ,
"Firs=+1/1/2007" = from 1/1/07 forward sorted ascanding.
Modify=["(First\Last)"] ["=(+\-){date}]" : file's last modified date (see
Creat).
Type=[stiring]: filetype as stiring with up to two wildcards (*), as the
first and last letters, e.g.: "*Excel*"
FoundFiles: the search result, a files/folders list as a collection object.
Remarks:
Filname & Foldername:
1. If there is no wildcards Search will look for the exact file name. IT
is ture to the whole file mane ("ABC.doc") and also to each parts: the name
("ABC") and the extention (".doc").
2. Filename has priority by default. To use Foldername Filename must be
empty (nothing), otherwise search will ignore Foldername.
Creat & Modify:
1. Modify has priority by default. To use Creat Modify must be empty
(nothing), otherwise Search will ignord Creat.
2. Use Creat and Modify with Filename or Foldername, otherwise Search will
return error.
3. With Foldername, "First\Last" are ignored and have no meaning. The
other parts of Creat\Modify ["=(+\-){date}"] are available in the regular
uses and meanings.
Filetype:
1. The file types are those Windows Vista declared and recognaized,
unbelievable stupidity like: "Microsoft Office Excel 1997-2003 Worksheet"
ect'.
So be wise and use wildcards, like: "*Word*" or "*Excel*" or better
and simpler, omit Filetype and use the file extansion instad.
2. For earlier Windows version, use FileTypes objects expression like:
"msoFileTypeWebPages", "msoFileTypeExcelWorkbooks" ect' (see VBA help topic
"FileType")
3. From time immemorial Windows replaces between created and modified
dates (at least the Hebrew versions). In order to defeat this mismatch, I use
".DateCreated " for modified date and ".DateLastModified" for created date.
If you bump into mismatch, all what you have to do is to repalce between
those to word, in 'FindFile' code.
FoundFiles:
FoundFiles is a collection object holding the search results, file/folder
names and if Creat or Modify is used, with the created\modified dates. Each
collection member is a item with item number and key. The key is a string
starting with the leter "K" and a serial number: K1,K2,K3...
For useaul use' You can get the search result by the item number:
[FoundFiles(1,2,3.....up to FoundFiles.Count)].
If you use Creat or Modify with "First\Last" and wish to get the results
by the right order, you must use the item key: [FoundFiles(K1,K2,k3.....up to
"K" & FoundFiles.Count)]
To run Search use code like:
Lokkin = "F:\Yoyo"
SubFolders = True
Filename = "Toto-Loan.*"
Modify="Last=1/1/07"
Search
To get Search results use code like:
Dim MFile, Count as Integer, Const Style = vbYesNo + vbDefaultButton2
Count = 0
'To get the results by item number
While Count < FoundFiles.Count
Count = Count+1
If MsgBox("You ar looking for" & Chr(10) & FoundFiles(Count), Style,
Title)=6 then
MFile = FoundFiles(Count)
Count = FoundFiles.Count +1
End If
Wend
'To get the results by item key (can't be used with FolderName search results)
While Count < FoundFiles.Count
Count = Count+1
If MsgBox("You ar looking for" & Chr(10) & FoundFiles("K" & Count),
Style, Title)=6 then
MFile = FoundFiles("K" & Count)
Count = FoundFiles.Count +1
End If
Wend
Remark: If expected lots of results (file/folder), it is better to
"translate" the FoundFiles Collection to a list wich will apear as a Msgbox
or to a text file.
Who to copy this very long "letter" from the seit, this you will have to
find youer selef. Hint, use Excel which "knows" to do almost every thing.
I'm not a regular member and even of this forum. so if you find mistakes,
bugs or have improvments, mail them to (e-mail address removed).
Please dont send qustions or help reqesets. You westing youer time for
nothng, because I don't have any intention to ansewer.
