Search for text in multiple excel files

[sc]

I am trying to write an add-in that will search for text inside multiple
files. I am using excel 2002. I got some code off the internet that would
open the files, copy and paste some text, and then close all the files in a
folder. I took some of the code out and added some to search for the text
and paste the file name in a cell if it contains the text I am searching for.
When I run the code, I do not get an error message. It just does not open
the first file. Below is the part of the code I modified.

Set destrange = basebook.Worksheets(1).Range("A" & rnum)
'start row for the info from the first file
rnum = 1

'loop through all files in the array (MyFiles)
If Fnum > 0 Then
For Fnum = LBound(MyFiles) To UBound(MyFiles)
Set mybook = Workbooks.Open(MyFiles(Fnum))

With Worksheets(1).Range.CurrentRegion
Set c = .Find(txtsearchfor)
If Not c Is Nothing Then
firstAddress = c.Address
Do
c.Address.Copy destrange

Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
'This will add the workbook name in column D if you want
basebook.Worksheets(1).Cells(rnum, "d").Value = MyFiles(Fnum)

End If

End With

mybook.Close savechanges:=False

rnum = rnum + SourceRcount

Next Fnum
End If



Here is all of the code together.

Private Sub cmdsearch_Click()
Dim SubFolders As Boolean
Dim Fsbj As Object, RootFolder As Object
Dim SubFolderInRoot As Object, file As Object
Dim RootPath As String, FileExt As String
Dim MyFiles() As String, Fnum As Long

Dim SourceRcount As Long, rnum As Long
Dim basebook As Workbook, mybook As Workbook
Dim sourceRange As Range, destrange As Range

'Loop through all files in the Root folder
RootPath = txtlookin.Text
'Loop Through the subfolder true or false
SubFolders = False
'Loop through files with this extension
FileExt = ".xls"

'Add a slash at the end if the user forgot it
If Right(RootPath, 1) <> "\" Then
RootPath = RootPath & "\"
End If

Set Fsbj = CreateObject("Scripting.FileSystemObject")
If Not Fsbj.folderexists(RootPath) Then
MsgBox RootPath & "Not Exist"
Exit Sub
End If

Set RootFolder = Fsbj.GetFolder(RootPath)

'Fill the array (myFiles) with the list of Excel files in the folders
Fnum = 0
'Loop through the files in the root folder
For Each file In RootFolder.Files
If LCase(Right(file.Name, 4)) = FileExt Then
Fnum = Fnum + 1
ReDim Preserve MyFiles(1 To Fnum)
MyFiles(Fnum) = RootPath & file.Name
End If
Next file

'Loop through the files in the sub folders if sub folders = true
If SubFolders Then
For Each SubFoldersInRoot In RootFolder.SubFolders
For Each file In SubFolderInRoot.Files
If LCase(Right(file.Name, 4)) = FileExt Then
Fnum = Fnum + 1
ReDim Preserve MyFiles(1 To Fnum)
MyFiles(Fnum) = SubFolderInRoot & "\" & file.Name
End If
Next file
Next SubFoldersInRoot
End If

'now we can open the files in the array MyFiles to do what we want
On Error GoTo CleanUp
Application.ScreenUpdating = False


Set basebook = ThisWorkbook

'clear all cells on the first sheet
basebook.Worksheets(1).Cells.Delete
Set destrange = basebook.Worksheets(1).Range("A" & rnum)
'start row for the info from the first file
rnum = 1

'loop through all files in the array (MyFiles)
If Fnum > 0 Then
For Fnum = LBound(MyFiles) To UBound(MyFiles)
Set mybook = Workbooks.Open(MyFiles(Fnum))

With Worksheets(1).Range.CurrentRegion
Set c = .Find(txtsearchfor)
If Not c Is Nothing Then
firstAddress = c.Address
Do
c.Address.Copy destrange

Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
'This will add the workbook name in column D if you want
basebook.Worksheets(1).Cells(rnum, "d").Value = MyFiles(Fnum)

End If

End With

mybook.Close savechanges:=False

rnum = rnum + SourceRcount

Next Fnum
End If

CleanUp:
Application.ScreenUpdating = True

End Sub



Any help would be much appreciated.