Wrox Programmer Forums
Go Back   Wrox Programmer Forums > Microsoft Office > Excel VBA > Excel VBA
|
Excel VBA Discuss using VBA for Excel programming.
Welcome to the p2p.wrox.com Forums.

You are currently viewing the Excel VBA section of the Wrox Programmer to Programmer discussions. This is a community of software programmers and website developers including Wrox book authors and readers. New member registration was closed in 2019. New posts were shut off and the site was archived into this static format as of October 1, 2020. If you require technical support for a Wrox book please contact http://hub.wiley.com
 
Old March 13th, 2018, 02:47 AM
Authorized User
 
Join Date: Apr 2009
Posts: 23
Thanks: 1
Thanked 0 Times in 0 Posts
Default Search a pair of string in closed workbooks

Hi folks,

Found below solution created by someone else. The code is not iterating through all the subdirectories and picking only Excel files which are located in Z:\Data directory, whereas I want it to read Excel files located in subdirectories also.

Your help would be much appreciated.

Thanks


<CODE>
Sub SearchFolders()
Dim fso As Object
Dim fld As Object
Dim strSearch As String
Dim strPath As String
Dim strFile As String
Dim wOut As Worksheet
Dim wbk As Workbook
Dim wks As Worksheet
Dim lRow As Long
Dim rFound As Range
Dim strFirstAddress As String

On Error GoTo ErrHandler
Application.ScreenUpdating = False

'Change as desired
strPath = "Z:\Data"
strSearch = "0.851"

Set wOut = Worksheets.Add
lRow = 1
With wOut
.Cells(lRow, 1) = "Workbook"
.Cells(lRow, 2) = "Worksheet"
.Cells(lRow, 3) = "Cell"
.Cells(lRow, 4) = "Text in Cell"
Set fso = CreateObject("Scripting.FileSystemObject")
Set fld = fso.GetFolder(strPath)

strFile = Dir(strPath & "\*.xls*")
Do While strFile <> ""
Set wbk = Workbooks.Open _
(Filename:=strPath & "\" & strFile, _
UpdateLinks:=0, _
ReadOnly:=True, _
AddToMRU:=False)

For Each wks In wbk.Worksheets
Set rFound = wks.UsedRange.Find(strSearch)
If Not rFound Is Nothing Then
strFirstAddress = rFound.Address
End If
Do
If rFound Is Nothing Then
Exit Do
Else
lRow = lRow + 1
.Cells(lRow, 1) = wbk.Name
.Cells(lRow, 2) = wks.Name
.Cells(lRow, 3) = rFound.Address
.Cells(lRow, 4) = rFound.value
End If
Set rFound = wks.Cells.FindNext(After:=rFound)
Loop While strFirstAddress <> rFound.Address
Next

wbk.Close (False)
strFile = Dir
Loop
.Columns("A:D").EntireColumn.AutoFit
End With
MsgBox "Done"




ExitHandler:
Set wOut = Nothing
Set wks = Nothing
Set wbk = Nothing
Set fld = Nothing
Set fso = Nothing
Application.ScreenUpdating = True
Exit Sub

ErrHandler:
MsgBox Err.Description, vbExclamation
Resume ExitHandler
End Sub

</CODE>

Last edited by SMI//; March 15th, 2018 at 02:05 AM..





Similar Threads
Thread Thread Starter Forum Replies Last Post
Search String? S Shirani Classic ASP Databases 1 October 23rd, 2009 03:10 PM
New text search doesn't preselect search string planoie Visual Studio 2005 0 July 23rd, 2007 06:47 AM
dropdownlist code-value pair mapping gagansharma7 General .NET 0 June 27th, 2006 02:11 PM
Search string Mantis PHP How-To 5 June 2nd, 2005 03:30 AM
Compile Error on Let/Get pair John K. King Pro VB 6 2 June 14th, 2004 01:00 PM





Powered by vBulletin®
Copyright ©2000 - 2020, Jelsoft Enterprises Ltd.
Copyright (c) 2020 John Wiley & Sons, Inc.