Поиск текста в документах Word

Option Explicit
Dim WordObj As Object
Dim WordDoc As Object
Dim MyPath As String
Dim iFileName As String
Sub Макрос1()
Set WordObj = CreateObject("Word.Application")
MyPath = "C:\Temp\" 'указать путь к папке
iFileName = Dir(MyPath) 'имя первого файла в папке. Не менять!!!
Do While iFileName <> ""
Set WordDoc = WordObj.Documents.Open(MyPath + iFileName) 'открываем первый файл
WordObj.Visible = True 'можно его отображать, можно не отображать
WordObj.Selection.Find.ClearFormatt ing
WordObj.Selection.Find.Replacement. ClearFormatting
With WordObj.Selection.Find
.Text = "21.03.2007" 'текст для поиска
.Replacement.Text = "27.03.2007" 'текст для замены, если мы хотим просто заменить старый
End With
WordObj.Selection.Find.Execute Replace:=2 '2 - означает заменить все
WordObj.Documents(iFileName).Close SaveChanges:=True 'сохраняем и закрываем файл
iFileName = Dir 'получение следующего имени файла в папке. Не менять!!!
Loop
WordObj.Quit 'закрываем MS WORD
Set WordDoc = Nothing 'освобождаем память
Set WordObj = Nothing 'освобождаем память
MsgBox "Файлы обработаны!", vbOKOnly + vbInformation, "Обработка файлов"
End Sub