aFFs() and the following Sub in it was already shown in previous posts.
Combining what I did with snb's findstr method, less the characters/65 it ran in 1.4 seconds. We could use GetDetailsOf() to get the word count quickly if that would help any.
snb does not use Option Explicit so Dim is not needed. Obviously, change the value of ws and p to suit.
You can delete the two lines with Timer if you don't want that. Debug.Print puts the result into the Immediate Window (Ctrl+G) after a run.
Sub snbkh() d = Timer Set ws = ThisWorkbook.Sheets(1) p = "C:\Users\lenovo1\Dropbox\Excel\Word\MainFolder\" On Error GoTo EndSub Application.EnableCancelKey = xlErrorHandler Set fso = CreateObject("Scripting.FileSystemObject") ReDim b(1 To Rows.Count, 1 To 3) sn = ws.Columns(1).SpecialCells(2) With CreateObject("WScript.Shell") For Z = 2 To UBound(sn) s = .Exec("cmd /c findstr /m/s SD/#" & Format(sn(Z, 1), "0000") & "/ " & _ """" & p & "*.doc" & """").StdOut.ReadAll If Len(s) <> 0 Then s = Left(s, Len(s) - 2) 'Trim trailing vbCrLF a = Split(s, vbCrLf) For i = 0 To UBound(a) j = j + 1 b(j, 1) = fso.GetFile(a(i)).Name b(j, 2) = sn(Z, 1) fn = fso.GetParentFolderName(a(i)) If Len(fn) > Len(p) Then b(j, 3) = Right(fn, Len(fn) - Len(p)) Next i End If Next Z End With If j = 0 Then GoTo EndSub b = Application.Index(b, Evaluate("row(1:" & j & ")"), Application.Transpose([row(1:3)])) ws.[B2].Resize(j, 3).Value = b ws.UsedRange.Columns.AutoFit EndSub: Set fso = Nothing Application.DisplayAlerts = True Application.EnableCancelKey = xlInterrupt Debug.Print Timer - d End Sub
[/QUOTE]
sorry for being late to reply. I have tried the the macro in folder MainFolder, but the macro did not print anything, just a blank excel.
Hats off to Hobs and snb, it worked when I reinstalled my office, solved a big headache. Thanks a lot.