从Delphi创建Word文档，另存为Doc和PDF

Question

我需要使用特定模板从Delphi创建Word文档，将文档另存为具有给定名称的Word文档，然后保存具有相同名称的同一文档但作为PDF文件。 （在Word 2007中可以使用SaveAsPdf ...插件完成，在Word 2010中是内置功能）

这怎么可以用Delphi XE来完成？

Answer 1

首先使用“组件”|“Microsoft Word 12对象”（MS Word 2007）类型库导入项目。导入组件菜单项。然后，您可以使用此示例代码加载MS Word文件，并使用内部PDF转换器将其另存为PDF。如果您使用的是Microsoft Word 2010中，加载它的类型库而不是Word 2007中

unit fMain; 

interface 

uses 
    Windows, SysUtils, Variants, Classes, Controls, Forms, Dialogs, StdCtrls, 
    Word_TLB; 

type 
    TfrmMain = class(TForm) 
    btnLoad: TButton; 
    btnSaveAs: TButton; 
    FileOpenDialog1: TFileOpenDialog; 
    FileSaveDialog1: TFileSaveDialog; 
    procedure btnLoadClick(Sender: TObject); 
    procedure FormClose(Sender: TObject; var Action: TCloseAction); 
    procedure btnSaveAsClick(Sender: TObject); 
    private 
    FWordApp : WordApplication; 
    FWordDoc : WordDocument; 
    procedure InitializeApp; 
    procedure FinalizeApp; 
    function LoadFile(const AFileName: string): WordDocument; 
    procedure SaveAsPdf(ADocument: WordDocument; const AFileName: string); 
    public 
    { Public declarations } 
    end; 

var 
    frmMain: TfrmMain; 

implementation 

uses ComObj; 

{$R *.dfm} 

procedure TfrmMain.btnLoadClick(Sender: TObject); 
begin 
    if FileOpenDialog1.Execute then 
    FWordDoc := LoadFile(FileOpenDialog1.FileName); 
end; 

procedure TfrmMain.btnSaveAsClick(Sender: TObject); 
begin 
    if FileSaveDialog1.Execute then 
    begin 
    if Assigned(FWordDoc) then 
     SaveAsPdf(FWordDoc, FileSaveDialog1.FileName); 
    end; 
end; 

procedure TfrmMain.FinalizeApp; 
var 
    SaveChanges: OleVariant; 
begin 
    if Assigned(FWordApp) then 
    begin 
    SaveChanges := False; 
    FWordApp.Quit(SaveChanges, EmptyParam, EmptyParam); 
    FWordApp := nil; 
    end; 
end; 

procedure TfrmMain.FormClose(Sender: TObject; var Action: TCloseAction); 
begin 
    FinalizeApp; 
end; 

procedure TfrmMain.InitializeApp; 
begin 
    FWordApp := createOleObject('Word.Application') as WordApplication; 
    if Assigned(FWordApp) then 
    begin 
    FWordApp.Visible := False; 
    end 
    else 
    raise Exception.Create('Cannot initialize Word application'); 
end; 

function TfrmMain.LoadFile(const AFileName: string): WordDocument; 
var 
    FileName: OleVariant; 
    Doc : WordDocument; 
begin 
    if not Assigned(FWordApp) then 
    InitializeApp; 

    FileName := AFileName; 
    Doc := FWordApp.Documents.Open(FileName, EmptyParam, EmptyParam, EmptyParam, 
           EmptyParam, EmptyParam, EmptyParam, EmptyParam, 
           EmptyParam, EmptyParam, EmptyParam, EmptyParam, 
           EmptyParam, EmptyParam, EmptyParam, EmptyParam); 
    Result := Doc; 
end; 

procedure TfrmMain.SaveAsPdf(ADocument: WordDocument; const AFileName: string); 
var 
    FileName, 
    FileFormat : OleVariant; 
begin 
    if Assigned(ADocument) then 
    begin 
    FileName := AFileName; 
    FileFormat := wdFormatPDF; 
    ADocument.SaveAs(FileName, FileFormat, EmptyParam, EmptyParam, EmptyParam, 
        EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, 
        EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, 
        EmptyParam); 
    end; 
end; 

end. 

我刚写的代码并运行它一次，它的工作原理，但我还没有彻底的测试，所以可能会有一些毛刺。

Answer 2

这段代码对我来说是诀窍，但正如你所看到的，我必须立即保存文档，并使用ShellExecute重新打开它。如果没有，我会提前提到'RPC服务器不可用'错误。

procedure TfrmJobsearchAdverts.FileCreate; 
var 
    TempName: OleVariant; 
    FileDoc: OleVariant; 
    FileFormat: OleVariant; 
    Doc : WordDocument; 
    WordTemplate: string; 
    WordFile: string; 
    BookName: OleVariant; 
begin 
    SaveRecord; 
    WordFile := Advert.CreateDocname(qryAdverts.FieldByName('fldadvert_date').AsDateTime); 
    WordTemplate := JobsearchTemplate(Self); 
    if (WordFile <> '') and (WordTemplate <> '') then 
    begin 
     Advert.SaveDocname(qryAdverts.FieldByName('fldadvert_guid').AsString, WordFile); 
     if not Assigned(fWordApp) then 
     InitializeWord; 
     TempName := WordTemplate; 
     FileDoc := WordFile; 
     Doc := FWordApp.Documents.Add(TempName, EmptyParam, EmptyParam, EmptyParam); 
     BookName := 'fldCompany'; 
     if Doc.Bookmarks.Exists(BookName) then 
     Doc.Bookmarks.Item(BookName).Range.Text := Company.Name; 
     BookName := 'fldAddress1'; 
     if Doc.Bookmarks.Exists(BookName) then 
     Doc.Bookmarks.Item(BookName).Range.Text := Company.Address1; 
     BookName := 'fldAddress2'; 
     if Doc.Bookmarks.Exists(BookName) then 
     Doc.Bookmarks.Item(BookName).Range.Text := Company.Address2; 
     BookName := 'fldZip'; 
     if Doc.Bookmarks.Exists(BookName) then 
     Doc.Bookmarks.Item(BookName).Range.Text := Company.Zip; 
     BookName := 'fldCity'; 
     if Doc.Bookmarks.Exists(BookName) then 
     Doc.Bookmarks.Item(BookName).Range.Text := Company.City; 
     FileFormat := wdFormatDocument; 
     Doc.SaveAs(FileDoc, EmptyParam, EmptyParam, EmptyParam, 
       EmptyParam, EmptyParam, EmptyParam, EmptyParam, 
       EmptyParam, EmptyParam, EmptyParam, EmptyParam, 
       EmptyParam, EmptyParam, EmptyParam, EmptyParam); 
     FinalizeWord; 
     Files.ExecuteAndWait(WordFile); 
    end; 
end;