Sub GetDocumentStats()
Application.ScreenUpdating = False
Dim strFolder As String, strFile As String, strDocNm As String
Dim strList As String, i As Long, wdDoc As Document
strDocNm = ActiveDocument.FullName: strFolder = "C:\Sam-Documents\VBA-Word"
strFile = Dir(strFolder & "\*.docx", vbNormal)
While strFile <> ""
  If strFolder & "\" & strFile <> strDocNm Then
    i = i + 1
    Set wdDoc = Documents.Open(FileName:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False)
    With wdDoc
      With .Range.Find
        .Text = strFnd
        .MatchCase = False
        .MatchAllWordForms = False
        .MatchWholeWord = False
        .Execute
        If .Found = True Then strList = strList & vbCr & strFile
      End With
      .Close SaveChanges:=False
    End With
  End If
  ' Let Word do its housekeeping
  DoEvents
  strFile = Dir()
Wend
Set wdDoc = Nothing
MsgBox i & " files processed." & vbCr & "Matches with " & strFnd & " found in:" & strList, vbOKOnly
Application.ScreenUpdating = True
End Sub

Option Explicit
Public FSO As Object 'a FileSystemObject
Public oFolder As Object 'the folder object
Public oSubFolder As Object 'the subfolders collection
Public oFiles As Object 'the files object
Dim i As Long, strNm As String, strFnd As String, strFile As String, strList As String

Sub FindTextInDocs()
' Minimise screen flickering

Dim wks As Worksheet
Set wks = Worksheets("sheet1")
Dim rowindex As Long
     rowindex = 3

wks.Range("B1").Value = i & " Files Processed."
wks.Range("C1").Value = "Matches with " & strFnd
wks.Range("B2").Value = "Found in"


On Error Resume Next
Set wdApp = GetObject("word.Application")
If Err Then
   Set wdApp = CreateObject("word.Application")
End If
  Set wdDoc = wdApp.Documents.Add


Application.ScreenUpdating = False
Dim strFolder As String

strFolder = ""
strDocNm = wdApp.ActiveDocument.FullName
strFolder = "C:\Characters-Folder\Word-Files\"
strFile = Dir(strFolder & "\*.docx", vbNormal)
strFnd = txtFindText.Text
While strFile <> ""
  If strFolder & "\" & strFile <> strDocNm Then
    i = i + 1
    Set wdDoc = wdApp.Documents.Open(FileName:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False)
    With wdDoc
      With .Range.Find
        .Text = strFnd
        .MatchCase = False
        .MatchAllWordForms = False
        .MatchWholeWord = False
        .Execute
        If .Found = True Then strList = strList & vbCr & strFile
               
      End With
      .Close SaveChanges:=False
    End With
  End If
  ' Let Word do its housekeeping
  DoEvents
  strFile = Dir()
'wks.Cells(rowindex, 2).Formula = strList
  'rowindex = rowindex + 1 

Wend
Set wdDoc = Nothing

''''''MsgBox i & " files processed." & vbCr & "Matches with " & strFnd & " found in:" & strList, vbOKOnly

'wks.Range("B3").Value = strFile & vbCr 'strList & vbCr

Application.ScreenUpdating = True

End Sub