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
 

Excel Facts

Back into an answer in Excel
Use Data, What-If Analysis, Goal Seek to find the correct input cell value to reach a desired result
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
//------------------------------------------------------------------------------------------------
 
Upvote 0
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
 
Upvote 0
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 :)
 
Upvote 0
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!
 
Upvote 0
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?
 
Upvote 0
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.
 
Upvote 0

Forum statistics

Threads
1,213,567
Messages
6,114,342
Members
448,570
Latest member
rik81h

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top