Копирование текста Word

Function FindAndReplace(ADocument1, ADocument2:TFileName; Str:string):boolean;
  Var WordDoc: OleVariant;
  const wdReplaceAll=1;
  Begin
   WordDoc:=CreateOLEObject('Word.Application');
   WordDoc.Visible:=false;
   WordDoc.Documents.Add(ADocument1);
   WordDoc.Documents.Add(ADocument2);
   WordDoc.Documents.Item(2).Activate;
  WordDoc.Selection.Find.MatchSoundsLike := False;
  WordDoc.Selection.Find.MatchAllWordForms := False;
  WordDoc.Selection.Find.MatchWholeWord := False;
  WordDoc.Selection.Find.Format := False;
  WordDoc.Selection.Find.Forward := True;
  WordDoc.Selection.Find.ClearFormatting;
  WordDoc.Selection.Find.Text:=Str;
  WordDoc.Selection.Find.Replacement.Text:=WordDoc.Documents.Item(1).Range.Text;
  FindAndReplace:=WordDoc.Selection.Find.Execute(Replace:=wdReplaceAll);
  WordDoc.ActiveDocument.SaveAs(ADocument2);
   WordDoc.Quit;
   WordDoc:=Unassigned;
  End;
procedure TForm1.Button1Click(Sender: TObject);
begin
FindAndReplace('C:/1.doc','C:/2.doc', '#paste');
end;
 
end.

// Процедура
Uses ComObj;
Function FindAndReplace(ADocument1, ADocument2:TFileName; S1, S2:string):boolean;
  Var WordDoc, FStart, FEnd, a, b: OleVariant;
  i,DocLen:longint;
  Begin
  Result:=false;
   FStart:=0;
   FEnd:=0;
   WordDoc:=CreateOLEObject('Word.Application');
   WordDoc.Visible:=false;
   WordDoc.Documents.Add(ADocument1);
   WordDoc.Documents.Add(ADocument2);
   WordDoc.Documents.Item(2).Activate;
  DocLen:=Length(WordDoc.Documents.Item(2).Range.Text);
    For i:=0 to DocLen-2 do begin
    a:=i; b:=i+2;
    if (WordDoc.Documents.Item(2).Range(a,b).Text=S1) then FStart:=i+2
    else if (WordDoc.Documents.Item(2).Range(a,b).Text=S2) then FEnd:=i;
    end;
  if (FStart=0) or (FEnd=0) then showmessage('Ошибка') else
 begin
  WordDoc.Documents.Item(2).Range(FStart, FEnd).Select;
  WordDoc.Selection.Copy;
 end;
//====================================================================
   FStart:=0;
   FEnd:=0;
   DocLen:=Length(WordDoc.Documents.Item(1).Range.Text);
  For i:=0 to DocLen-2 do begin
    a:=i; b:=i+2;
    if (WordDoc.Documents.Item(1).Range(a,b).Text=S1) then FStart:=i
    else if (WordDoc.Documents.Item(1).Range(a,b).Text=S2) then FEnd:=i+2;
    end;
 
 if (FStart=0) or (FEnd=0) then showmessage('Ошибка') else
 begin
  WordDoc.Documents.Item(1).Range(FStart, FEnd).Select;
  WordDoc.Selection.Paste;
  Result:=true;
 end;
  WordDoc.Documents.Item(1).Activate;
  WordDoc.ActiveDocument.SaveAs(ADocument2);
   WordDoc.Quit;
   WordDoc:=Unassigned;
  End;
 
//Пример вызова
procedure TForm1.Button1Click(Sender: TObject);
begin
FindAndReplace('C:/1.doc','C:/2.doc', '<#', '#>');
end;