uses ComObj;
var WordApp: Variant;
begin
WordApp := CreateOleObject('Word.Application');
WordApp.Documents.open('c:/1.doc');
WordApp.Selection.InsertFile('c:/2.doc','',False,false,false);
WordApp.Selection.InsertFile('c:/3.doc','',False,false,false);
WordApp.ActiveDocument.SaveAs('C:/4.doc');//,'wdFormatDocument',False,'',True,'',False,False,False,False,False);
WordApp.Quit;
OleContainer1.CreateObjectFromFile('c:/4.doc',true);
procedure TFrm_Main.btUniteClick(Sender: TObject);
var
I: Integer ;
DocFileName: String ;
DocFile:OleVariant ;
begin
if lvFileName.Items.Count <1 then
Exit ;
btUnite.Enabled := False ;
try
pnJC.Visible := True ;
Frm_Main.Update ;
try
WordA.Connect ;
WordA.Visible := True;
WordDocument1.ConnectTo(WordA.Documents.Add(EmptyParam,EmptyParam,EmptyParam,EmptyParam) );
MixWordWindow('Word 文档合并器');
for I := 0 to lvFileName.Items.Count -1 do
begin
ProgressBar1.Position := I * 100 div lvFileName.Items.Count ;
Label3.Caption := lvFileName.Items.Item[I].SubItems.Strings[0] ;
Frm_Main.Update ;
DocFileName := lvFileName.Items.Item[I].SubItems.Strings[0] ;
WordA.Selection.InsertFile(DocFileName,EmptyParam,EmptyParam,EmptyParam,EmptyParam) ;
end;
ProgressBar1.Position := 100 ;
if CheckBox1.Checked then
begin
DocFile := edDocFileName.Text ;
WordDocument1.SaveAs(DocFile);
end ;
if CheckBox2.Checked then lvFileName.Items.Clear ;
if (CheckBox3.Checked) and (CheckBox1.Checked) then WordA.Quit ;
WordA.Disconnect ;
if CheckBox1.Checked then
Application.MessageBox(PChar('文档合并工作已经成功的完成。保存在' + #13+ edDocFileName.Text ),'完成', MB_OK or MB_ICONINFORMATION)
else
Application.MessageBox(PChar('文档合并工作已经成功的完成。请及时保存该文档！' ),'完成', MB_OK or MB_ICONINFORMATION) ;
if CheckBox1.Checked then
begin
DocCount := DocCount + 1 ;
edDocFileName.Text := ExtractFilePath(edDocFileName.Text) + '合并文档'+ IntToStr(DocCount) +'.Doc' ;
end;
except
on E: Exception do
begin
Application.MessageBox(PChar('系统在合并Word文档时发生错误，请重试！' + #13 + E.message),'系统错误', MB_OK or MB_ICONERROR);
end;//end except On
end;
finally
btUnite.Enabled := True ;
pnJC.Visible := False ;
ProgressBar1.Position := 0 ;
Label3.Caption := '正在启动 Microsoft Word...' ;
end;
end;