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.
|
|
Dmitry Kostochko
Add-in Express team
Posts: 2887
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?
|
|
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 |
|
Dmitry Kostochko
Add-in Express team
Posts: 2887
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?
|
|
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
|
|