filesearch excel 2003 to 2007

pablobarra

New Member
Joined
Apr 30, 2007
Messages
4
Hello

This works fine with excel 2003, but now I´m moving to excel 2007 and don´t know how to change "filesearch" code.
Can anyone help me??
thanks in advanced
_____________________________________
Private Sub Workbook_Open()
Application.DisplayAlerts = False
On Error Resume Next
Dim basebook As Workbook
Dim mybook As Workbook
Dim pt As PivotTable
Dim ws As Worksheet
With Application.FileSearch
.NewSearch
.LookIn = "C:\Consultas\"
.SearchSubFolders = True
.FileType = msoFileTypeExcelWorkbooks
If .Execute() > 0 Then
For i = 1 To .FoundFiles.Count
Set mybook = Workbooks.Open(.FoundFiles(i), UpdateLinks:=0, IgnoreReadOnlyRecommended:=True, corruptload:=0)
For Each ws In ActiveWorkbook.Worksheets
For Each pt In ws.PivotTables
pt.PivotCache.MissingItemsLimit = xlMissingItemsNone
Next pt
Next ws
ActiveWorkbook.RefreshAll
ActiveWorkbook.Save
ActiveWorkbook.Close
Next i
End If
End With
Application.Quit
End Sub
 

Some videos you may like

Excel Facts

Excel Joke
Why can't spreadsheets drive cars? They crash too often!

PavHabr

New Member
Joined
Jun 24, 2009
Messages
4
Re: Replacement solution including searching in subdirectories

//------------------------------------------------------------------------------------------------
Sub FileSearchByHavrda_Example_of_procedure_calling()
'
' Example of FileSearchByHavrda procedure calling as replacement of missing FileSearch function in the newest MS Office VBA
' 01.06.2009, Author: P. Havrda, Czech Republic
'
Dim FileNameWithPath As Variant
Dim ListOfFilenamesWithParh As New Collection ' create a collection of filenames
' Filling a collection of filenames (search Excel files including subdirectories)
Call FileSearchByHavrda(ListOfFilenamesWithParh, "C:\Temp", "*.xls", True)
' Print list to immediate debug window and as a message window
For Each FileNameWithPath In ListOfFilenamesWithParh ' cycle for list(collection) processing
Debug.Print FileNameWithPath & Chr(13)
MsgBox FileNameWithPath & Chr(13)
Next FileNameWithPath
' Print to immediate debug window and message if no file was found
If ListOfFilenamesWithParh.Count = 0 Then
Debug.Print "No file was found !"
MsgBox "No file was found !"
End If
End Sub
//------------------------------------------------------------------------------------------------
Private Sub FileSearchByHavrda(pFoundFiles As Collection, pPath As String, pMask As String, pIncludeSubdirectories As Boolean)
'
' Search files in Path and create FoundFiles list(collection) of file names(path included) accordant with Mask (search in subdirectories if enabled)
' 01.06.2009, Author: P. Havrda, Czech Republic
'
Dim DirFile As String
Dim CollectionItem As Variant
Dim SubDirCollection As New Collection
' Add backslash at the end of path if not present
pPath = Trim(pPath)
If Right(pPath, 1) <> "\" Then pPath = pPath & "\"
' Searching files accordant with mask
DirFile = Dir(pPath & pMask)
Do While DirFile <> ""
pFoundFiles.Add pPath & DirFile 'add file name to list(collection)
DirFile = Dir ' next file
Loop
' Procedure exiting if searching in subdirectories isn't enabled
If Not pIncludeSubdirectories Then Exit Sub
' Searching for subdirectories in path
DirFile = Dir(pPath & "*", vbDirectory)
Do While DirFile <> ""
' Add subdirectory to local list(collection) of subdirectories in path
If DirFile <> "." And DirFile <> ".." Then If ((GetAttr(pPath & DirFile) And vbDirectory) = 16) Then SubDirCollection.Add pPath & DirFile
DirFile = Dir 'next file
Loop
' Subdirectories list(collection) processing
For Each CollectionItem In SubDirCollection
Call FileSearchByHavrda(pFoundFiles, CStr(CollectionItem), pMask, pIncludeSubdirectories) ' Recursive procedure call
Next
End Sub
//------------------------------------------------------------------------------------------------
 

tom2977

New Member
Joined
Jan 12, 2012
Messages
4
I tried the Havra filesearch routine above and found it rather slow for the application i need. I am not expert in vba nor programming (this is my 1st ever forum post) but i have compiled the following routine which seems to operate nearly as quickly as application.filesearch did and much faster than the above routines.

It uses the dir() command recursively and uses an array rather than a collection........
The test opens the found file and times the search,

Sub TestSearch()
Dim filename As String
Dim Path As String
Dim ColFiles() As String
Time1 = Timer
filename = "Enter filename or part of filename here"
Path = "Enter Path Here"
Call FileSearch2007(ColFiles, Path, filename, True)
On Error Resume Next
Err.Clear
n = LBound(ColFiles)
If Err.Number = 0 Then
filename = ColFiles(1)
Workbooks.Open filename
End If
Time2 = Timer - Time1
MsgBox Time2 & " Seconds"
End Sub

Sub FileSearch2007(ByRef ColFiles() As String, Path As String, OriginalFileName As String, IncludeSubfolders As Boolean)

Dim Mysubfolder As Folder, i As Integer
Set MyObject = New Scripting.FileSystemObject
Set MySource = MyObject.GetFolder(Path)
Application.StatusBar = "Searching For:" & OriginalFileName & " In " & Path
Application.EnableEvents = False
Application.DisplayAlerts = False

On Error GoTo NoFilesFound
filename = Dir(Path & "\*")
If filename = "" Then GoTo NoFilesFound

On Error Resume Next
i = 1
i = UBound(ColFiles) + 1 'For subfolders the array size must not reset to 1!

' Loop until no more matching files are found
Do While filename <> ""
'The Like command is used if wildcards are present in the filename
If InStr(OriginalFileName, "*") > 0 Or InStr(OriginalFileName, "?") > 0 Then
If filename Like OriginalFileName Then
ReDim Preserve ColFiles(i)
ColFiles(i) = Path & "\" & filename
i = i + 1
End If
Else
If InStr(filename, OriginalFileName) > 0 Then
ReDim Preserve ColFiles(i)
ColFiles(i) = Path & "\" & filename
i = i + 1
End If
End If
filename = Dir 'Move to the next file
Loop

NoFilesFound:
'Loop through the subfolders
If IncludeSubfolders Then
For Each Mysubfolder In MySource.SubFolders
FileSearch2007 ColFiles, Mysubfolder.Path, OriginalFileName, True
Next
End If
Application.DisplayAlerts = True
Application.EnableEvents = True

End Sub
 

PavHabr

New Member
Joined
Jun 24, 2009
Messages
4
If you use script by tom2977, you have to activate Microsoft Scripting Runtime, in the VBEditor choose References from the Tools menu. Then, you have to check the Microsoft Scripting Runtime option and click OK. Once you reference the library, you have access to the object Scripting.FileSystemObject.

This is "NOT REQUIRED" if you are using script FileSearchByHavrda_Example_of_procedure_calling() by me.

It's only small note :)
 

tom2977

New Member
Joined
Jan 12, 2012
Messages
4
That is true! Forgot to mention it. Thanks! :)

Your code worked very well for me until i had to use it to do searches across network drives with a large number of subfolders and files. As i said above, for some reason (and much to my surprise!) i found the above code much quicker. :confused: I wondered if using the collection object was somehow slower than working with an array but i am not sure....I did not try to pin down the answer. I would be interested to know why.

Anyway i shared the code above as an alternative approach and i hope it's useful to someone (in the way your solution has been).

BTW, i apologise for any ugly parts of the code, I am still at the stage when i am pleased if something works at all!
 

Timmer4

New Member
Joined
Jan 18, 2012
Messages
1
If you use script by tom2977, you have to activate Microsoft Scripting Runtime, in the VBEditor choose References from the Tools menu. Then, you have to check the Microsoft Scripting Runtime option and click OK. Once you reference the library, you have access to the object Scripting.FileSystemObject.

This is "NOT REQUIRED" if you are using script FileSearchByHavrda_Example_of_procedure_calling() by me.

It's only small note :)
I'm using your routine however it is not getting the files in correct order. For example, it should find the following files in order of:
file000-date
file001-date
...
file143-date


Instead, it found the following:
file004
...
file009
file000
file001
file002
file003
file010
...

Any suggestions?
 

tom2977

New Member
Joined
Jan 12, 2012
Messages
4
Hi,
I don't know of any way directly but in my routine above, the results are passed to an array and you could sort that before outputting the results. There are solutions out there to doing this either by passing to a worksheet or in code. Here's a link i found but i haven't tested it:

http://www.cpearson.com/excel/SortingArrays.aspx

Good luck.
 

Watch MrExcel Video

Forum statistics

Threads
1,101,923
Messages
5,483,730
Members
407,406
Latest member
ishipra

This Week's Hot Topics

  • Finding issue in If elseif else with For each Loop
    Finding issue in If elseif else with For each Loop I have tried this below code but i'm getting in Y column filled with W005. Colud you please...
  • MsgBox Error
    Hi Guys, I have the below error show up when i try and run my macro in File1 but works fine if i copy and paste the same code into file2. [ATTACH...
  • CELL FORMAT - IF CONDITION
    My Cell Format is [B]""0.00" Cr". [/B]But in the cell, it is showing 123.00 for editing. (123 is entry figure). (Data imported from other...
  • Show numbers nearly the same
    Is this possible. I have a number that can change very time eg 0.00001234 Then I have a lot of numbers 0.0000001, 0.0000002, 0.00000004...
  • Please i need your help to create formula
    I need a formula in cell B8 to do this >>if b1=1 then multiply ( cell b8) by 10% ,if b1=2 multiply by 20%,if=3 multiply by 30%. Thank you in...
  • Got error while adding column and filter
    Got error while adding column and filter In column Z has some like "Success" and "Error". I want to add column in AA if the Z cell value is...
Top