snb's example was to show how findstr can help. Change MsgBox.Exec to MsgBox .Exec in post #21.
I can not duplicate your system restore issue. When a macro "hangs" and ESC key presses or Break key does not abort it, the 3 finger solute (Alt+Ctrl+Del, Task Manager, Kill) is the usual method to Kill the Excel instance. It is always best to run a macro like mine by itself with no other Excel files open. That is, at least until you know what to expect.
I can not duplicate your timing problem for those files. I did say it took a "long time" to run. My run with your files took about 44 seconds. Anything over 5 seconds is a long time to me. I like to see under one second but you wanted to get the character count / 65 for each match.
snb or I could show you how to modify his code to do what mine does, less the character count / 65.
I added an ESC key option. When you abort a macro like mine, it can leave an instance of Word that needs to be Killed via 3 finger solute before another run or you could get an OLE error.
Sub Main()
Dim p$, fn$, i As Long, j As Long, r As Long, c As Integer
Dim a, b, e, rr As Range, cc As Range
Dim ws As Worksheet, o As Object, s$
Dim fso As Object 'New Scripting.FileSystemObject
Dim d#
d = Timer
'******************* INPUTS **********************************
p = ThisWorkbook.Path & "\" 'Parent folder
Set ws = Worksheets(1)
'******************* END INPUTS ******************************
'List of 4 digit numbers. 'e.g. SD/#7301/, SD/#0231/
Set rr = ws.Range("A2", ws.Cells(Rows.Count, "A").End(xlUp))
On Error GoTo EndSub
Application.EnableCancelKey = xlErrorHandler
Application.DisplayAlerts = False
a = aFFs(p & "*.doc", , True)
If Not IsArray(a) Then Exit Sub
Set fso = CreateObject("Scripting.FileSystemObject")
ReDim b(1 To Rows.Count, 1 To 4)
For Each e In a
Set o = GetObject(e)
s = o.Content
For Each cc In rr
i = InStr(s, "SD/#" & cc.Text & "/")
If i > 0 Then
j = j + 1
b(j, 1) = fso.GetFile(CStr(e)).Name
b(j, 2) = cc.Text
fn = fso.GetParentFolderName(CStr(e))
If Len(fn) > Len(p) Then b(j, 3) = Right(fn, Len(fn) - Len(p))
b(j, 4) = WorksheetFunction.Round(Len(s) / 65, 0)
End If
Next cc
o.Close False
Next e
Set fso = Nothing
If j = 0 Then Exit Sub
b = Application.Index(b, Evaluate("row(1:" & j & ")"), Application.Transpose([row(1:4)]))
ws.[B2].Resize(j, 4).Value = b
ws.UsedRange.Columns.AutoFit
EndSub:
Set fso = Nothing
Application.DisplayAlerts = True
Application.EnableCancelKey = xlInterrupt
Debug.Print Timer - d
End Sub
Reply With Quote
Originally Posted by Kenneth Hobs
