unit Unit1;

interface

uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, ComObj, StdCtrls;

type
 TForm1 = class(TForm)
   Memo1: TMemo;
   Button1: TButton;
   procedure FormCreate(Sender: TObject);
   procedure Button1Click(Sender: TObject);
 private
   { Private declarations }
 public
   { Public declarations }
 end;

var
 Form1: TForm1;

implementation
var StringMass: array [1..6] of string;
   i:integer;
{$R *.dfm}

type
 TWordReplaceFlags = set of (wrfReplaceAll, wrfMatchCase, wrfMatchWildcards);

function Word_StringReplace(ADocument: TFileName; StringMass: array of string; Flags: TWordReplaceFlags): Boolean;
const
 wdFindContinue = 1;
 wdReplaceOne = 1;
 wdReplaceAll = 2;
 wdDoNotSaveChanges = 0;
var
 WordApp: OLEVariant;
 
begin  
 Result := False;  
   i:=1;
 { Check if file exists }  
 if not FileExists(ADocument) then  
 begin  
   ShowMessage('Specified Document not found.');  
   Exit;  
 end;  

 { Create the OLE Object }  
 try  
   WordApp := CreateOLEObject('Word.Application');  
 except  
   on E: Exception do  
   begin  
     E.Message := 'Word is not available.';  
     raise;  
   end;  
 end;  

 try
 
   { Hide Word }
   WordApp.Visible := False;
   { Open the document }
   WordApp.Documents.Open(ADocument);
   { Initialize parameters}
   WordApp.Selection.Find.ClearFormatting;
    while i<=6 do begin
   WordApp.Selection.Find.Text := StringMass[i];
   WordApp.Selection.Find.Replacement.Text := StringMass[i+1];
   i:=i+2;  end;
   WordApp.Selection.Find.Forward := True;
   WordApp.Selection.Find.Wrap := wdFindContinue;
   WordApp.Selection.Find.Format := False;
   WordApp.Selection.Find.MatchCase := wrfMatchCase in Flags;
   WordApp.Selection.Find.MatchWholeWord := False;
   WordApp.Selection.Find.MatchWildcards := wrfMatchWildcards in Flags;
   WordApp.Selection.Find.MatchSoundsLike := False;
   WordApp.Selection.Find.MatchAllWordForms := False;
   { Perform the search}
   if wrfReplaceAll in Flags then
     WordApp.Selection.Find.Execute(Replace := wdReplaceAll)
   else
     WordApp.Selection.Find.Execute(Replace := wdReplaceOne);
   { Save word }
   WordApp.ActiveDocument.SaveAs(ADocument);  
   { Assume that successful }
   Result := True;
   { Close the document }  
   WordApp.ActiveDocument.Close(wdDoNotSaveChanges);  
 finally  
   { Quit Word }  
   WordApp.Quit;  
   WordApp := Unassigned;  
 end;  
end;

procedure TForm1.FormCreate(Sender: TObject);
var i:integer;
begin
Memo1.Text:='';
Memo1.Lines.Append('*word1');
Memo1.Lines.Append('*pasted1');
Memo1.Lines.Append('*word2');
Memo1.Lines.Append('*pasted2');
Memo1.Lines.Append('*word3');
Memo1.Lines.Append('*pasted3');
for i:=1 to 6 do
StringMass[i]:=Memo1.Lines.ValueFromIndex[i-1];
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
Word_StringReplace('C:\Test.doc', StringMass, [wrfReplaceAll]);
end;

end.