Ooops! To clarify the above, SearchPath & "\" & FileName gives you the full path right to the workbook.
At any rate... Name a sheet "Found" in the workbook that runs the code, and replace the FindAll routine with this:
[vba]Option Compare Text
Option Explicit
Sub FindAll(SearchPath As String, SearchText As String, ToProcess As Integer)
'Macro purpose: Loop through all Excel Workbooks and search each of them for the
'specified criteria
Dim WB As Workbook
Dim WS As Worksheet
Dim FileName As String
Dim TermFound As Boolean
Dim i As Integer
Dim Processed As Integer
Dim BoxText As String
Dim Problem As Boolean
'Turn off screen flashing & taskbar updates
With Application
.ScreenUpdating = False
.ShowWindowsInTaskbar = False
End With
'Clear the list of hyperlinks from the "Found" sheet
With ThisWorkbook.Worksheets("Found")
.Range("A2:A" & .Range("A65536").End(xlUp).Row).ClearContents
.Range("A1").Value = "Location of workbooks holding the term: " & SearchText
End With
'Assign first filename in directory to FileName variable
FileName = Dir(SearchPath & "\*.xls", vbNormal)
'Expand ufSearch to show progress bar
With ufSearch
.Height = 174
.Repaint
End With
Do
'Set problem to false then attempt to open workbook and set WB & WS variables
'(If an error results, set the Problem variable to true)
Problem = False
On Error Resume Next
Set WB = Workbooks.Open(FileName:=SearchPath & "\" & FileName, ReadOnly:=True) _
', Password:="Uncomment and put password here if required"
If Err.Number <> 0 Then Problem = True
On Error Resume Next
If Problem = False Then
TermFound = False
For Each WS In WB.Worksheets
'If no error, check all textboxes in the file for search term
For i = 1 To WS.TextBoxes.Count
BoxText = WS.TextBoxes(i).Text
If InStr(1, BoxText, SearchText) > 0 Then
'If the search term is found, set TermFound to true,
'and stop checking further (exit the loop)
TermFound = True
Exit For
End If
Next i
If TermFound = True Then
'If the search term was found add it to the list of hyperlinks
With ThisWorkbook.Worksheets("Found")
.Hyperlinks.Add _
Anchor:=.Range("A65536").End(xlUp).Offset(1, 0), _
Address:=SearchPath & "\" & FileName, _
TextToDisplay:=SearchPath & "\" & FileName
End With
Exit For
End If
Next WS
End If
'Close the workbook
'(On error resume next in case WB never opened at all)
On Error Resume Next
WB.Close False
On Error GoTo 0
'Inform the user how many files have been processed and update the progress bar
Processed = Processed + 1
Call UpdateProgress(Processed / ToProcess)
'Release WB & WS variables and set FileName to next file
Set WB = Nothing
Set WS = Nothing
FileName = Dir() 'sets FileName to next file in directory
Loop Until FileName = ""
'Restore screen updating, show open files on taskbar and clear statusbar
With Application
.ScreenUpdating = True
.ShowWindowsInTaskbar = True
End With
'Hide the progress indicator
With ufSearch
.Hide
End With
'Inform the user how many files were opened (number of opened files)
MsgBox WorksheetFunction.CountA(ThisWorkbook.Worksheets("Found").Range("A2:A" & _
ThisWorkbook.Worksheets("Found").Range("A65536").End(xlUp).Row)) _
& " files were found which matched your search term!", _
vbOKOnly + vbInformation, x & " Files Found!"
ThisWorkbook.Worksheets("Found").Activate
End Sub[/vba]
I think that should do what you're after... (FYI, it will overwrite the list every time you run it as well, so no need to clear it out.)![]()
Let me know!