G'day all!
I have a problem with the Devil's work - Word OLEAutomation.....
Code is below, but the problem is that given a resultset of say 5 records, the
data is updated in the variables, but does get appear in the Word Doc, so 5
identical documents are printed.
Whilst composing this email I noticed
wrdMerge.ConnectTo(wraMerge.Documents.Item(ItemIndex));
uses ItemIndex which does not change. I can try incrementing this when I get
home this evening if anyone thinks this could be it, but any other advice
welcome!!
Cheers,
Martin.
procedure TfmDiary.GenerateLetter;
procedure AddBookmark(InField: string; InStr: OleVariant);
var
ItemIndex: OleVariant;
Idx: OleVariant;
BM: Bookmark;
S: string;
NBM: Integer;
P: Integer;
i: Integer;
begin
ItemIndex := InField;
NBM := wraMerge.ActiveDocument.Bookmarks.Count;
i := 1;
if NBM > 0 then
repeat
Idx := i;
BM := wraMerge.ActiveDocument.Bookmarks.Item(Idx);
S := BM.Name;
//-----Check for Uppercase function
if (Length(S) > 0) and (S[1] = 'U') then
begin
InStr := UpperCase(InStr);
Delete(S, 1, 1);
end;
P := Pos('_', S);
if P > 0 then
S := Copy(S, 1, P - 1);
if S = InField then
begin
wraMerge.ActiveDocument.Bookmarks.Item(Idx).Select;
wraMerge.Selection.Text := InStr;
NBM := wraMerge.ActiveDocument.Bookmarks.Count;
end
else
Inc(i);
until i > NBM;
end;
var
NewTemplate: OleVariant;
SaveSpellCheck: OleVariant;
SaveGrammarCheck: OleVariant;
Template: OleVariant;
ItemIndex: OleVariant;
FAddress1 : string;
FOleTodayDate: OleVariant;
FOleAddress : OleVariant;
DataReturn: TDataReturn;
begin
try
DataReturn := TDataReturn.Create;
try
DataReturn.DoParamAPICall(SPMMGetChngAppForMerge);
if Assigned(DataReturn.Data) then
begin
dlgTemplate.InitialDir := 'D:\Projects\Templates';
dlgTemplate.FileName := 'CLIChangeClientApp.dot';
if not dlgTemplate.Execute then
exit;
Template := dlgTemplate.FileName;
wraMerge := TWordApplication.Create(Application);
wraMerge.AutoConnect := False;
wraMerge.AutoQuit := False;
wraMerge.ConnectKind := ckRunningOrNew;
wrdMerge := TWordDocument.Create(Application);
wrdMerge.AutoConnect := False;
wrdMerge.ConnectKind := ckRunningOrNew;
wraMerge.Visible := False;
try
wraMerge.Disconnect;
except
end;
try
wraMerge.Connect;
except
on e:exception do
begin
MessageDlg('Word may not be installed', mtError, [mbOk], 0);
Abort;
end;
end;
//-----Get information about actor
FOleTodayDate := '';
FOleAddress := '';
ItemIndex := 1;
NewTemplate := False;
FOleTodayDate := FormatDateTime('dd mmmm yyyy', Now);
try
//-----Turn Spell checking off because it takes a long time
//-----if enabled and slows down Winword
SaveSpellCheck := wraMerge.Options.CheckSpellingAsYouType;
SaveGrammarCheck := wraMerge.Options.CheckGrammarAsYouType;
wraMerge.Options.CheckSpellingAsYouType := False;
wraMerge.Options.CheckGrammarAsYouType := False;
ShowWordInfo('Loading document template ...');
wraMerge.Documents.AddOld(Template, NewTemplate);
wrdMerge.ConnectTo(wraMerge.Documents.Item(ItemIndex));
while not DataReturn.data.EOF do
begin
FOleAddress := DataReturn.data.FieldByName('address').asString;
// THIS LINE FUDGED FOR ELISTS!!
AddBookmark('TodayDate', FOleTodayDate);
AddBookmark('Address', FOleAddress );
wrdMerge.PrintOut;
DataReturn.data.Next;
end;
finally
//-----Reset Word spell/grammar check to entry settings
wraMerge.Options.CheckSpellingAsYouType := SaveSpellCheck;
wraMerge.Options.CheckGrammarAsYouType := SaveGrammarCheck;
//-----Close Word
QuitWordApp;
ShowWordInfo('');
end;
end;
finally
DataReturn.Free;
end;
except
on E: Exception do
begin
messagedlg('Error in Generate Letter : '+E.Message,mtError,[mbOK],0);
wraMerge.Disconnect;
ShowWordInfo('');
end;
end;
end;
_______________________________________________
Delphi mailing list -> [email protected]
http://www.elists.org/mailman/listinfo/delphi
