Option Explicit

Const msoFileTypeWordDocuments = 3
Const wdDoNotSaveChanges = 0
Const wdAlertsNone = 0

Dim objWord

Dim objFSO
Dim strPathToCopy

Dim i

Set objWord = CreateObject("Word.Application")
Set objFSO = CreateObject("Scripting.FileSystemObject")

objWord.DisplayAlerts = wdAlertsNone

With objWord.FileSearch
    .NewSearch                                    ' Очистить критерии поиска
    .LookIn = "%userprofile%\Мои документы"       ' Где искать
    .SearchSubFolders = True                      ' Искать в подпапках?
    '.FileName = "*.doc"                          ' Можно и так, но, в целях совместимости,
                                                  '   лучше так, как ниже
    .FileType = msoFileTypeWordDocuments          ' Ищем в файлах Word
    .TextOrProperty = "текст для поиска"          ' Текст для поиска
    
    If .Execute > 0 Then                          ' Файлы найдены?
        MsgBox "Найдено " & .FoundFiles.Count & " файл(ов)"
        
        For i = 1 To .FoundFiles.Count
            MsgBox .FoundFiles(i)
        Next
    Else
        MsgBox "Файлы не найдены"
    End If
End With

Set objFSO = Nothing
objWord.Quit wdDoNotSaveChanges
Set objWord = Nothing