4
votes

I need to create a Word document from Delphi using a specific template, save the document as a Word document with a given name and then save the same document with the same name but as a PDF file. (In Word 2007 it can be done using the SaveAsPdf... plugin. In Word 2010 it is a built in feature)

How can this be done using Delphi XE?

2
I do it with vbscript. Would that help? - David Heffernan
@TLama no offense intended, just for me it has been a long time since I left Delphi (with tears of course)and I thought it should be the case for all. - Ali
What do you have already? Do you know how to open a document in Word? What Word version will be available on the client? If it is Word 2010 it should not be very difficult. Just use COM to open the document and save it as pdf, just what you want. - Birger

2 Answers

6
votes

First import "Microsoft Word 12 Objects" (MS Word 2007) type library into your project by using Components | Import Components menu item. Then you can use this sample code to load a MS Word file, and save it as PDF using the internal PDF converter. If you are using Microsoft Word 2010, load its type library instead of 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.

I just wrote the code and ran it once, it works, but I have not tested it thoroughly, so there might be some glitches.

0
votes

This code does the trick for me, but as you can see I have to save the doc at once and the reopen it using ShellExecute. If not I get the 'RPC Server not available' error i mentioned earlyer.

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;