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