Find the string in all excel files in destination folder and subfolders

[praveenpatel421983]

Hi all,

I am trying to write a code to search a strings listed in the active sheet in all excel files in a folder having multi level of subfolders. I searched and found following code which is working for me but I need to search only sheet called "Test" in each excel file. This code searches in every sheet. Please help to restrict it to "Test" sheet.



Public Sub NonRecursiveMethod()
Dim FSO, oFolder, oSubfolder, oFile, queue As Collection
Application.DisplayAlerts = False
Application.ScreenUpdating = False

Set FSO = CreateObject("Scripting.FileSystemObject")
Set queue = New Collection
queue.Add FSO.GetFolder("D:\ToolTest")


Do While queue.Count > 0
Set oFolder = queue(1)
queue.Remove 1 'dequeue

For Each oSubfolder In oFolder.SubFolders
queue.Add oSubfolder 'enqueue
Sheets("Sheet1").Range("A2") = oSubfolder.path

Call LoopThroughFiles

Next oSubfolder

Loop
Application.DisplayAlerts = True
Application.ScreenUpdating = True


MsgBox "Done"


End Sub




Sub LoopThroughFiles()
Dim file As Variant
Dim sht As Worksheet, path As String, y As Range

Application.DisplayAlerts = False
Application.ScreenUpdating = False

i = 2
path = ThisWorkbook.Sheets("sheet1").Range("a2").Value
If Right(path, 1) <> "" Then path = path & ""
file = Dir(path & "*.xls*")
While (file <> "")
Workbooks.Open path & file
For Each cell In ThisWorkbook.Sheets("sheet1").Range("B4:B53")

For Each sht In ActiveWorkbook.Sheets


Set y = sht.Cells.Find(What:=cell.Value, After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False)


If y Is Nothing Then
GoTo Skip:
Else
ThisWorkbook.Sheets("sheet2").Range("a" & i).Value = cell.Value
ThisWorkbook.Sheets("sheet2").Range("b" & i).Value = y.Address
ThisWorkbook.Sheets("sheet2").Range("c" & i).Value = sht.Name
ThisWorkbook.Sheets("sheet2").Range("d" & i).Value = file
ThisWorkbook.Sheets("sheet2").Range("e" & i).Value = path
i = i + 1
End If
found = y.Address

Skip:


Next sht
Next cell
ActiveWorkbook.Close

file = Dir()
Wend
On Error GoTo 0
Application.DisplayAlerts = True
Application.ScreenUpdating = True


End Sub