Contact OnWrite event

Add-in Express™ Support Service
That's what is more important than anything else

Contact OnWrite event
Parameter ContactItem = empty??? 
Nicola Biada


Guest


Hi,
I'm trying do develop a small add-i that should catch item on new mail and on new contact.

On new mail all works fine, but on new contact (event OnWrite) it returns an empty sender object.

Thank in advance for any suggestions:

unit BCOlAddin_IMPL;

interface

uses
Dialogs, SysUtils, ComObj, ComServ, ActiveX, Variants, adxAddIn, BCOlAddin_TLB, StdVcl,
Classes, Forms, Windows, Outlook2000, cxContainer, cxEdit, cxLookAndFeels, Controls,
OleServer, IniFiles;

type
TClsBCOlAddin = class(TadxAddin, IClsBCOlAddin)
end;

TAddInModule = class(TadxCOMAddInModule)
adxOlInspectorCommandBar1: TadxOlInspectorCommandBar;
adxOlExplorerCommandbar1: TadxOlExplorerCommandbar;
cxLookAndFeelController1: TcxLookAndFeelController;
procedure adxOlInspectorCommandBar1Controls1Click(Sender: TObject);
procedure adxCOMAddInModuleAddInInitialize(Sender: TObject);
procedure adxCOMAddInModuleAddInFinalize(Sender: TObject);
procedure adxOlExplorerCommandbar1Controls1Click(Sender: TObject);
procedure adxOlExplorerCommandbar1Controls0Click(Sender: TObject);
private
//
FInspectorList: TList;
FInspectors: TInspectors;
FContactItem: TContactItem;
function GetWordLang(word: OleVariant): string;
protected
//
public

procedure DoNewInspector(ASender: TObject; const Inspector: _Inspector);
procedure DoInspectorActivate(ASender: TObject);
procedure DoInspectorClose(ASender: TObject);

procedure DoItemSend(ASender: TObject; const Item: IDispatch;
var Cancel: WordBool);
procedure DoContactWrite(ASender: TObject; var Cancel: WordBool);
end;

implementation

uses uAbout, uFrmIntegraCRM;

{$R *.dfm}

procedure TAddInModule.adxOlInspectorCommandBar1Controls1Click(
Sender: TObject);
begin
ShowMessage('Ok');
end;

procedure TAddInModule.DoItemSend(ASender: TObject; const Item: IDispatch;
var Cancel: WordBool);
var
iMail: MailItem;
nPar: HWND;
sTitolo, sMsg: string;
lWord: OleVariant;

begin
if Assigned(Item) then
begin
Item.QueryInterface(IID__MailItem, iMail);
if Assigned(iMail) then
try

{
Verifico se esiste u'istanza attiva di Word.
se non è vero vuol dire che l'integrazione con Outlook è sicuramente disattivata.
}

nPar := FindWindow('OpusApp', nil);
if nPar > 0 then
begin
lWord := GetActiveOleObject('Word.Application'); // prendo l'OLE object attivo
sMsg := GetWordLang(lWord); // prendo la frase finale per il titolo della finestra
end; // nella lingua in cui è attivo Word

sTitolo := iMail.Subject + ' - ' + sMsg;

FrmIntegraCRM := TFrmIntegraCRM.Create(nil);
FrmIntegraCRM.Parent := nil;
nPar := FindWindow('OpusApp', PAnsiChar(sTitolo));

{
Se non esiste un'istanza di Word non titolo uguale al Subject della Mail più
la stringa "Messaggo" nella lingua corretta vuol dire che è aperta un'altra istanza di
Word ma non in integrazione con Outlook
}
if nPar < 1 then
begin
nPar := GetActiveWindow;
end;

{
ShowMessage('GetActWin.Handle=' + IntToStr(GetActiveWindow) + #13 +
'App.Handle=' + IntToStr(Application.Handle) + #13 +
'OpusApp.noTitolo.Handle=' + IntToStr(FindWindow('OpusApp', '')) + #13 +
'OpusApp.Handle=' + IntToStr(FindWindow('OpusApp', PAnsiChar(sTitolo))) + #13 +
'Subject="' + PAnsiChar(sTitolo) + '"' + #13 +
'nPar=' + IntToStr(nPar)
);
}

FrmIntegraCRM.ParentWindow := nPar;
if IsPositiveResult(FrmIntegraCRM.ShowModal) then
ShowMessageFmt('Integrazione email inviata a "%s" ' + #13 + '%s', [iMail.To_, iMail.Body]);
finally
iMail := nil;
FreeAndNil(FrmIntegraCRM);
end;
end;
end;

procedure TAddInModule.adxCOMAddInModuleAddInInitialize(Sender: TObject);
var
pFolder: MAPIFolder;
iniFile: TIniFile;
sFolderID, sStoreID: string;

begin
{
ShowMessage('AWiHandle=' + IntToStr(GetActiveWindow) + #13 +
'SelfHandle=' + IntToStr(Application.Handle));
}
Application.Handle := GetActiveWindow;

FContactItem := nil;
FInspectors := nil;
FInspectorList := TList.Create;

if OutlookApp.ActiveExplorer <> nil then
begin
OutlookApp.OnItemSend := DoItemSend;
FInspectors := TInspectors.Create(nil);
FInspectors.ConnectTo(OutlookApp.Inspectors);
FInspectors.OnNewInspector := DoNewInspector;
end;
end;

procedure TAddInModule.adxCOMAddInModuleAddInFinalize(Sender: TObject);
begin
OutlookApp.OnItemSend := nil;
end;

procedure TAddInModule.adxOlExplorerCommandbar1Controls1Click(
Sender: TObject);
begin
ShowMessage('Ok generale 2');
end;

procedure TAddInModule.adxOlExplorerCommandbar1Controls0Click(
Sender: TObject);
begin
AboutBox := TAboutBox.Create(Self);
AboutBox.ShowModal;
end;



function TAddInModule.GetWordLang(word: OleVariant): string;
const
wdUS = $00000001;
wdCanada = $00000002;
wdLatinAmerica = $00000003;
wdNetherlands = $0000001F;
wdFrance = $00000021;
wdSpain = $00000022;
wdItaly = $00000027;
wdUK = $0000002C;
wdDenmark = $0000002D;
wdSweden = $0000002E;
wdNorway = $0000002F;
wdGermany = $00000031;
wdPeru = $00000033;
wdMexico = $00000034;
wdArgentina = $00000036;
wdBrazil = $00000037;
wdChile = $00000038;
wdVenezuela = $0000003A;
wdJapan = $00000051;
wdTaiwan = $00000376;
wdChina = $00000056;
wdKorea = $00000052;
wdFinland = $00000166;
wdIceland = $00000162;

var
CountryID: TOleEnum;
sOut: string;

begin
CountryID := word.System.Country;

case CountryID of
wdItaly: sOut := 'Messaggio';
wdGermany: sOut := 'Nachricht';
end;

Result := sOut;

end;


procedure TAddInModule.DoInspectorActivate(ASender: TObject);
var
IContact: ContactItem;
begin
IContact := nil;
if (ASender is TInspector) and Assigned((ASender as TInspector).CurrentItem) then
(ASender as TInspector).CurrentItem.QueryInterface(IID__ContactItem, IContact);
if Assigned(IContact) then
try
if Assigned(FContactItem) then
begin
FContactItem.Disconnect;
FContactItem := nil;
end;
FContactItem := TContactItem.Create(nil);
FContactItem.ConnectTo(IContact);
FContactItem.OnWrite := DoContactWrite;
finally
IContact := nil;
end;
end;


procedure TAddInModule.DoInspectorClose(ASender: TObject);
var
Index: Integer;
begin
Index := FInspectorList.IndexOf(ASender);
if Index >= 0 then
begin
TInspector(FInspectorList[Index]).Disconnect;
FInspectorList.Delete(Index);
end;
end;

procedure TAddInModule.DoNewInspector(ASender: TObject;
const Inspector: _Inspector);
var
IContact: ContactItem;
Insp: TInspector;
begin
IContact := nil;
if Assigned(Inspector) and Assigned(Inspector.CurrentItem) then
Inspector.CurrentItem.QueryInterface(IID__ContactItem, IContact);
if Assigned(IContact) then
try
Insp := TInspector.Create(nil);
Insp.ConnectTo(Inspector);
Insp.OnActivate := DoInspectorActivate;
Insp.OnClose := DoInspectorClose;
FInspectorList.Add(Insp);
finally
IContact := nil;
end;
end;

procedure TAddInModule.DoContactWrite(ASender: TObject;
var Cancel: WordBool);
var
fname: string;
lContact: TContactItem;
begin
inherited;
try
if ASender is TContactItem then
begin
lContact := TContactItem(ASender);
fname := lContact.LastFirstAndSuffix;
ShowMessage('Saving "' + fname + '"...');
end;
except
//
end;
end;

initialization
TadxFactory.Create(ComServer, TClsBCOlAddin, CLASS_ClsBCOlAddin, TAddInModule);

end.
Posted 26 Jan, 2005 09:43:53 Top
Dmitry Kostochko


Add-in Express team


Posts: 2880
 Joined: 2004-04-05
Hi Nicola,

Just created and tested a small Outlook add-in. Works fine. For testing I used the Email1DisplayName property and I got it in the OnWrite event handler.

What do you mean by "empty sender object"? Is it nil or a valid TContactItem with empty properties? What Outlook version do you use?

Posted 26 Jan, 2005 10:27:23 Top
Nicola Biada


Guest


Dmitry Kostochko!

in my DoContactWrite:
if ASender is TContactItem <<== OK
lContact := TContactItem(ASender); <== no error, should be ok
ShowMessage(lContact.<anything>) <== Empty box !!!

-- Outlook 2003
Posted 26 Jan, 2005 10:41:48 Top
Dmitry Kostochko


Add-in Express team


Posts: 2880
 Joined: 2004-04-05
A bit strange... In my case it was Outlook 2003+SP1 too. It seems you use Delphi 7, am I right? Do you use MS Exchange Server? Do you have a fully filled contact item for testing?
Posted 26 Jan, 2005 10:52:58 Top
Nicola Biada


Guest


Stop all !!!!

It was a problem of my WinXP, after a reboot all works fine.

Thank you very much for your support.


Sincerly

Nicola

Posted 26 Jan, 2005 10:53:25 Top