Home |
Search |
Today's Posts |
#1
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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").Getfold er(FldrClc(1)).DateLastModified, CreateObject("Scripting.FileSystemObject").Getfold er(FldrClc(1)).DateCreated) < _ Dayy, IIf(Creat = "", CreateObject("Scripting.FileSystemObject").Getfold er(FldrClc(1)).DateLastModified, CreateObject("Scripting.FileSystemObject").Getfold er(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").Getfold er(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 . Please dont send qustions or help reqesets. You westing youer time for nothng, because I don't have any intention to ansewer. |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
Filesearch no longer functions | Excel Programming | |||
Filesearch in VB6 | Excel Programming | |||
FileSearch | Excel Programming | |||
FileSearch using VBA | Excel Programming | |||
.FileSearch | Excel Programming |