Okay, just to be difficult, I opted on an easier method than all the progress indicators. I only had a couple of minutes tonight, and it's way quicker to go this route. To use the progress indicator, the code should really be broken up a bit, so that it can be called in chunks from the userform. I say this because the trigger point to update the file count is in the middle of the block.
I don't have the time to go that route, so I've settled on updating the StatusBar in the bottom left hand corner of the Excel screen instead. (Where it probably says "Ready" right now.) It still gives progress, but unfortunately isn't as noticeable as the full on progress indicators we talked about earlier. I'm still willing to give those a shot, but let's try this first and see if it works (and is acceptable) for you.
I've also added two functions, which go in the standard module with the findall routine. One is to check if the directory exists, before jumping into the FindAll code, and the other is to count the number of files in the directory to measure our progress. One caveat about that one, though... it counts all files, so can give incorrect results if you have non-excel files. I had 4 files, 1 a zip file, so it ran up to 75% complete, and then finished. It didn't get to 100%, as the routine only actually opens Excel files. (The code still completes, it just looks like it's done prematurely.)
So here's all the new code:
STANDARD MODULE:
[vba]Option Compare Text
Option Explicit
Function FolderExists(Folder As String) As Boolean
'Function purpose: To count all files in a directory
Dim fso As Object, _
SubFolder As Object
'Create objects to get a count of files in the directory
Set fso = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
Set SubFolder = fso.GetFolder(Folder).Files
If Err.Number <> 0 Then
FolderExists = False
Else
FolderExists = True
End If
On Error GoTo 0
End Function
Function CountFiles(Directory As String) As Double
'Function purpose: To count all files in a directory
Dim fso As Object, _
SubFolder As Object
'Create objects to get a count of files in the directory
Set fso = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
Set SubFolder = fso.GetFolder(Directory).Files
If Err.Number <> 0 Then
CountFiles = 0
Else
CountFiles = SubFolder.Count
End If
On Error GoTo 0
End Function
Sub FindAll(SearchPath As String, SearchText As String)
'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, x As Integer
Dim Processed As Integer, ToProcess As Integer
Dim BoxText As String
Dim Problem As Boolean
'Turn off screen flashing
Application.ScreenUpdating = False
'Count number of files to proces, and assign first filename in directory to
'FileName variable
ToProcess = CountFiles(SearchPath)
FileName = Dir(SearchPath & "\*.xls", vbNormal)
Do
'Inform the user how many files have been processed
Processed = Processed + 1
Application.StatusBar = "Processing file " & Processed & " of " & _
ToProcess & " (" & Int(Processed / ToProcess * 100) & "% complete)"
'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"
Set WS = WB.Sheets("Data")
If Err.Number <> 0 Then Problem = True
On Error Resume Next
If Problem = True Then
'If an error resulted, (Problem is True,) 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
Else
'If no error, check all textboxes in the file for search term
TermFound = False
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 = False Then
'If the search term was not found, close the file
WB.Close False
Else
'If the search term was found, add 1 to the count of
'opened files using x as variable to hold the info
x = x + 1
End If
End If
'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 = ""
'Inform the user how many files were opened (number of opend files held in x)
MsgBox x & " files were found which matched your search term!", _
vbOKOnly + vbInformation, x & " Files Found!"
'Restore screen updating and clear statusbar
Application.ScreenUpdating = True
Application.StatusBar = False
End Sub[/vba]
USERFORM CODE:
[vba]Option Explicit
Private Sub cmdOkay_Click()
Const MainPath = "\\Disc1\StockData\Year"
Dim Prompt As String
'Make sure both textboxes have values assigned
If Not IsDate(tbDate.Value) Then Prompt = "Please enter a prompt date" & vbCrLf
If tbSearch.Value = "" Then Prompt = Prompt & "Please enter something to search for"
If Prompt = "" Then
'If Prompt is empty, then no problems were detected
If FolderExists(MainPath & Year(tbDate) & "\" & Format(tbDate, "mmm")) Then
'If the folder for the month exists call the FindAll routine
Call FindAll(MainPath & Year(tbDate) & "\" & Format(tbDate, "mmm"), tbSearch.Value)
Unload Me
Else
'If the folder for the month does not exist, notify the user
MsgBox "The information you entered generated a file path of:" & vbCrLf & _
MainPath & Year(tbDate) & "\" & Format(tbDate, "mmm") & vbCrLf & vbCrLf & _
"That file path does not exist! Please modify your selection and try again!", _
vbOKOnly + vbCritical, "Folder does not exist!"
End If
Else
'If Prompt is not empty, tell the user what info need correcting and return to the
'userform
MsgBox "Sorry, but I need more information!" & vbCrLf & Prompt, _
vbCritical + vbOKOnly, "Hang on!"
End If
End Sub
Private Sub cmdCancel_Click()
'Unload the userform
Unload Me
End Sub
Private Sub UserForm_Initialize()
'Put today's date in the userform
tbDate.Value = Format(Now(), "mm/dd/yyyy")
End Sub[/vba]
Let me know how that works, and if you'd rather go the full progress indicator.
Cheers,
Reply With Quote
).
)
.
sorry, sorry Ken. I was to quick to reply and you were to quick to answer. I kept the old code in the workbook and put your modifications in an new module but forgot to change the names, double names!
Originally Posted by airborne
.
