PDA

View Full Version : Master Directory Search (Needs A Tweak)



hillster
09-27-2012, 08:20 AM
I have a spreadsheet that searches through my directory to find and open a specific sheet in the workbook it automatically opens. It does that but only after pressing ok several times. Upon closing the workbook, you have to press ok several more times. I almost have it working. Does anyone know how to get it to stop having to press ok so many times? thank you so much for any help.

I have attached the spreadsheet for easy analysis.

Bob Phillips
09-27-2012, 08:39 AM
Can't test it, but as a guess

Sub SearchFolder(sFolderPath, sFind)
Dim EA As Excel.Application
Dim EAWb As Excel.Workbook
Dim FSO As Object
Dim oFile As Object
Dim oFolder As Object
Dim rngFound As Range
Dim ws As Worksheet
Dim MacroSecurity As Long

Set EA = CreateObject("Excel.Application")
MacroSecurity = EA.AutomationSecurity
EA.AutomationSecurity = 3 'msoAutomationSecurityForceDisable
Set FSO = CreateObject("Scripting.FileSystemObject")

For Each oFile In FSO.GetFolder(sFolderPath).Files
If Left(LCase(FSO.GetExtensionName(oFile.Path)), 3) = "xls" Then
Set EAWb = EA.Workbooks.Open(oFile.Path)
For Each ws In EAWb.Sheets
If ws.Name = "Communication Log" Then
Set rngFound = Nothing
Set rngFound = ws.Cells.Find(sFind)
If Not rngFound Is Nothing Then
MsgBox "Found Match in " & oFile.Path
EA.Goto ws.Range(rngFound.Address)
EA.Visible = True
EA.AutomationSecurity = MacroSecurity
Exit Sub
End If
End If
Next ws
EAWb.Close False
End If
Next
MsgBox Replace(Mid(sTest, 3), "||", Chr(10))

For Each oFolder In FSO.GetFolder(sFolderPath).SubFolders
Call SearchFolder(oFolder.Path, sFind)
Next

EA.AutomationSecurity = MacroSecurity
Set EA = Nothing
Set FSO = Nothing
Set oFile = Nothing
Set oFolder = Nothing
sOutput = vbNullString
End Sub

BTW, why do you start another Excel instance?

hillster
09-27-2012, 08:48 AM
Thanks xld, am I supposed to completely remove the prior code and paste yours, or add to what is already in the worksheet? The Other Excel instance is the next project I want to do.

thanks,

hillster
09-27-2012, 08:55 AM
Sub SearchFolder(sFolderPath, sFind)

Error says "Ambiguous Name Detected: Search Folder". Not sure what that means but, it is not working as of yet. Thank you so much for any help you can offer on this.

thanks,

hillster
09-27-2012, 09:05 AM
Ok, I figured out that it is replacing the other code entirely, however, it is doing the same thing. What it appears to be doing is seaching through all of the workbooks with the sheet named "Communication Log". It does it on the initial search for a file and then again after closing the file that it found from the initial search. It actually opens every workbook and displays the worksheet named "Communication Log". Not good. I have aprox. 4 workbooks in the particular master folder named "Insurance Jobs" that the search is looking through (subfolders). If I had a ton of folders with workbooks containing the sheet named "Communication Log", It would take forever to get them opened or closed. Hopefully this explanation will help. Sorry if it confuses things. Sometimes trying to explain things like this causes more confusion as it may not be worded well.

thank you,

sport1
05-02-2013, 10:59 AM
Hi

I am having trouble with the search function after I select a directory for a workbook to search.
The code is doing part of what it supposed to do. It open and runs through each workbook in the directory. But it is not finding the value I am searching for in each of the worksheet. It just continues to open all the different workbooks in the directory. I am missing something but not sure what.
The search is working fine in the beginning of the code. It just when I go to search the directory that it is not finding the value I enter in my textbox. Could you help me


Option Explicit
Sub test_1()
Dim ws As Worksheet
Dim rFound As Range
Dim strName As String
Dim doyou As String
Dim docopy$
Dim xArea As Range
Dim eArea As Range
Dim xData As Workbook
Dim xName$, ePath$
Dim fPicker As Object
Dim bsearch$
With Application
' .ScreenUpdating = False
.EnableEvents = False
.DisplayAlerts = False
End With
docopy = MsgBox("Do you want to copy?", vbYesNo)
If docopy = vbYes Then
Set xArea = Application.InputBox(prompt:="Copy Area", title:="Select Range", Type:=8)
Rem any select any worksheet And cell
strName = InputBox("Enter Cross Ref#")
If strName = "" Then Exit Sub
For Each ws In Worksheets
With ws.UsedRange
Set rFound = .Find(What:=strName, After:=.Cells(1, 1), LookIn:=xlValues, LookAt:=xlWhole)
If Not rFound Is Nothing Then
Application.Goto rFound, True
doyou = MsgBox("Do you want to continue searching?", vbYesNo)
If doyou = vbNo Then Exit Sub

End If
End With
Next ws
MsgBox "Value not found"
End If
doyou = MsgBox("Do you want to Search Directory?", vbYesNo)
If doyou = vbNo Then Exit Sub
Do
Set fPicker = Application.FileDialog(msoFileDialogFolderPicker)
With fPicker
.Show
ePath = .SelectedItems(1) & "\"
End With
xName = Dir(ePath & "*.xls*")
Do While Len(xName) > 0
Set xData = Workbooks.Open(ePath & xName)
For Each ws In Worksheets
With ws.UsedRange
Set rFound = .Find(What:=strName, After:=.Cells(1, 1), LookIn:=xlValues, LookAt:=xlWhole)
If strName = "" Then Exit Sub
If Not rFound Is Nothing Then
Application.Goto rFound, True
doyou = MsgBox("Do you want to continue searching?", vbYesNo)
If doyou = vbNo Then Exit Sub

End If
xData.Close False
xName = Dir
End With
Next ws
Loop
bsearch = MsgBox("Value not found, do you want to search another directory?", vbYesNo)
Loop Until bsearch = vbNo
With Application
' .ScreenUpdating = True
.EnableEvents = True
.DisplayAlerts = True

End With

MsgBox "Value not found"
End Sub

snb
05-02-2013, 12:28 PM
@SPORT1

I do not see any connection to the thread you posted in.
You'd probably better start a new/own thread/question