Application.FileSearch in Excel 2007!

  • Thread starter Thread starter Mark
  • Start date Start date
M

Mark

Hello, I recently upgraded to 2007 about 8 months ago, and had not run
this report I developed since the upgrade and have since googled and
found that Application.FileSearch no longer exists. I have been trying
to use some of the code snippets to modify my existing code but
NOTHING seems to work, can anyone assist in helping me mofidy this
code?? Thanks so much in advance.

Sub CheckTextFilesForHREFs()

Globalindx = 1
'MsgBox "Press OK to begin report"
Dim WholeLine As String
Dim myPath As String, FilesInPath As String
Dim workfile As String
Dim myR As Long


Set fs = Application.FileSearch
With fs
.LookIn = "C:\Exeloncorp"
.FileName = ".html"
.SearchSubFolders = True
If .Execute(SortBy:=msoSortByFileName, _
SortOrder:=msoSortOrderAscending) > 0 Then
MsgBox "There were " & .FoundFiles.Count & _
" file(s) found."
Application.ScreenUpdating = False
For i = 1 To .FoundFiles.Count

ParseURL .FoundFiles(i)

Next i
Application.ScreenUpdating = True
Else
MsgBox "There were no files found."
End If
Next
End Function
 
'!!!!! 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

//------------------------------------------------------------------------------------------------
 
Back
Top