Option Explicit

Const wdFindContinue = 1

Const wdParagraph = 4
Const wdCharacter = 1
Const wdExtend = 1


Dim strSourceFile
Dim strDestFile

Dim strSorceFilePattern
Dim strDestFilePhrase


Dim strText
Dim strContent

Dim boolFound


strSourceFile = "E:\Песочница\0404\test\Список.doc"
strDestFile   = "E:\Песочница\0404\test\Test22.txt"

strSorceFilePattern = "от [0-9]{2}.[0-9]{2}.[0-9]{4} @№"
strDestFilePhrase   = "Auto File Transfer"


With WScript.CreateObject("Scripting.FileSystemObject")
    If .FileExists(strSourceFile) Then
        If .FileExists(strDestFile) Then
            boolFound = False
            
            With WScript.CreateObject("Word.Application")
                '.Visible = True
                
                With .Documents.Open(strSourceFile)
                    With .Content.Find
                        .ClearFormatting
                        .Text = strSorceFilePattern
                        
                        .Forward = True
                        .Wrap = wdFindContinue
                        
                        .Format = False
                        .MatchCase = False
                        .MatchWholeWord = False
                        .MatchAllWordForms = False
                        .MatchSoundsLike = False
                        .MatchWildcards = True
                        
                        With .Replacement
                            .Text = ""
                            .ClearFormatting
                        End With
                        
                        If .Execute() Then
                            With .Parent
                                .EndOf wdParagraph, wdExtend
                                .MoveEnd wdCharacter, -1
                                strText = .Text
                            End With
                            
                            boolFound = True
                        End If
                    End With
                    
                    .Close
                End With
                
                .Quit
            End With
            
            If boolFound Then
                With .OpenTextFile(strDestFile)
                    strContent = .ReadAll()
                    .Close
                End With
                
                If InStr(1, strContent, strDestFilePhrase, vbTextCompare) > 0 Then
                    With .CreateTextFile(strDestFile, True)
                        .Write Replace(strContent, strDestFilePhrase, strText)
                        .Close
                    End With
                Else
                    WScript.Echo "Can't find phrase [" & strDestFilePhrase & "] in destination file [" & strDestFile & "]."
                    WScript.Quit 4
                End If
            Else
                WScript.Echo "Can't find any text by pattern [" & strSorceFilePattern & "] in source file [" & strSourceFile & "]."
                WScript.Quit 3
            End If
        Else
            WScript.Echo "Can't find destination file [" & strDestFile & "]."
            WScript.Quit 2
        End If
    Else
        WScript.Echo "Can't find source file [" & strSourceFile & "]."
        WScript.Quit 1
    End If
End With

WScript.Quit 0