Just to remind the problem
If I create a new email and start typing email address in To, Outlook
suggests some emails in a popup
Most emails look like Slava Barouline < email@com > , but sme have only
address or display name
The later fill recipients table incorrectly and don't get resolved even if
I call MailItem.Save in my code
I suspect Outlook delays resolving for some reason.
If I save email in Outlook by pressing a button, emails get resolved and
look OK in recipients table
Here it is (very scary code):
//Save before processing sent email:
.....
//Save before accessing PR_BODY
FMailItemToProcess.Save;
ASubject := FMailItemToProcess.Subject;
ABody := GetEmailBody;
...
//Get Recipients List
AnEmailAddresses := GetRecipientEmailAddresses;
.....
//Get emails from recipients table
function TMessageProcessor.GetRecipientEmailAddresses: TStringList;
var
OneMessage: IMessage;
RecTable:IMAPITable;
begin
RecTable:=nil;
OneMessage :=IUnknown(FMailItemToProcess.MAPIOBJECT) as IMessage;
OleCheck(OneMessage.GetRecipientTable(0,RecTable));
result := GetRecipientEmailAddressesFromTable(RecTable);
RecTable := nil;
OneMessage := nil;
end;
function
TMessageProcessor.GetRecipientEmailAddressesFromTable(RecTable:IMAPITable):
TStringList;
type
LTSPropTagArray =
record
cValues : ULONG;
aulPropTag : array[0..3] of ULONG;
end;
const
FPropTagArray : LTSPropTagArray = (cValues:4;
aulPropTag
PR_DISPLAY_NAME,
PR_EMAIL_ADDRESS,
PR_ADDRTYPE,
PR_ENTRYID)
);
var
NRec :integer;
ListRecTable:IMAPITable;
RecCount:Ulong;
lppRows
SRowSet;
EMailAddress, AnAddressType, ADisplayName: string;
i: Integer;
DistList: IDistList;
AddrBook: IAddrBook;
lpcbeid, ulObjectType: ULONG;
lppeid: PENTRYID;
ProcessInternalEmails, AskConfirmation: Boolean;
begin
result := TStringList.Create;
lppRows:=nil;
ProcessInternalEmails := False;
AskConfirmation := True;
OleCheck(RecTable.SetColumns(@FPropTagArray,TBL_BATCH));
OleCheck(RecTable.GetRowCount(0,RecCount));
dmMain.LogLine('Found ' + IntToStr(RecCount) + ' recipient(s)');
if RecCount>0 then
try
OleCheck(RecTable.QueryRows(RecCount,TBL_NOADVANCE,lppRows));
for Nrec:=0 to RecCount-1 do
begin
// PR_EMAIL_ADDRESS is an optional property
// therefore we must access it in a try except
try
AnAddressType :=
lppRows.aRow[Nrec].lpProps[lppRows.aRow[Nrec].cValues-2].Value.lpsza;
if UpperCase(AnAddressType) = 'MAPIPDL' then
begin
dmMain.LogLine('Found private distribution list - trying to
expand');
//!!! Get DistList
AddrBook := GetAddressBook;
//The IAddrBook.OpenEntry method opens an address book entry
//and returns a pointer to an interface that can be used
//to access the entry.
lpcbeid :=
lppRows.aRow[Nrec].lpProps[lppRows.aRow[Nrec].cValues-1].Value.bin.cb;
lppeid :=
LPENTRYID(lppRows.aRow[Nrec].lpProps[lppRows.aRow[Nrec].cValues-1].Value.bin.lpb);
DistList:=nil;
ulObjectType:=8; //MAPI_DISTLIST
OleCheck(AddrBook.OpenEntry(
lpcbeid,
lppeid,
@IID_IDistList,
MAPI_BEST_ACCESS or MAPI_DEFERRED_ERRORS,
ulObjectType,
IUnknown(DistList)));
OleCheck(DistList.GetContentsTable(0,ListRecTable));
with GetRecipientEmailAddressesFromTable(ListRecTable) do
for i:= 0 to Count - 1 do
result.AddObject(Strings
, Objects);
DistList:=nil;
ListRecTable := nil;
end
//Check Exchange email address type and ProcessInternalEmails
setting
else if (UpperCase(AnAddressType) = 'EX')
and not dmMain.ProcessInternalEmails then
begin
if ProcessInternalEmails then
begin
EMailAddress :=
lppRows.aRow[Nrec].lpProps[lppRows.aRow[Nrec].cValues-3].Value.lpsza;
ADisplayName :=
lppRows.aRow[Nrec].lpProps[lppRows.aRow[Nrec].cValues-4].Value.lpsza;
dmMain.LogLine('Recipient #' + IntToStr(Nrec + 1) + ' - email
address: ' + EMailAddress + ' , display name: ' + ADisplayName);
result.AddObject(EMailAddress,
TStringObject.Create(ADisplayName));
end
else
begin
EMailAddress :=
lppRows.aRow[Nrec].lpProps[lppRows.aRow[Nrec].cValues-3].Value.lpsza;
ADisplayName :=
lppRows.aRow[Nrec].lpProps[lppRows.aRow[Nrec].cValues-4].Value.lpsza;
dmMain.LogLine('Recipient #' + IntToStr(Nrec + 1) + ' - email
address: ' + EMailAddress + ' , display name: ' + ADisplayName);
dmMain.LogLine('Email address has Exchange address type');
//Manual processing
if AskConfirmation and FIsManualProcessing then
begin
if MessageDlg(strExchangeRecipientAddressTypeConfirmation,
mtConfirmation, [mbYes, mbNo], 0) = mrYes then
begin
ProcessInternalEmails := True;
result.AddObject(EMailAddress,
TStringObject.Create(ADisplayName));
end
else
begin
ProcessInternalEmails := False;
dmMain.LogLine('Email address skipped');
end;
AskConfirmation := False;
end
//Automatic processing - skip
else
dmMain.LogLine('Email address skipped');
end;
end
else
begin
//In case PR_EMAIL_ADDRESS is not found, use PR_DISPLAY_NAME
instead
ADisplayName :=
lppRows.aRow[Nrec].lpProps[lppRows.aRow[Nrec].cValues-4].Value.lpsza;
try
EMailAddress :=
lppRows.aRow[Nrec].lpProps[lppRows.aRow[Nrec].cValues-3].Value.lpsza;
except
dmMain.LogLine('Failed to read PR_EMAIL_ADDRESS, using
PR_DISPLAY_NAME instead');
EMailAddress := ADisplayName;
end;
dmMain.LogLine('Recipient #' + IntToStr(Nrec + 1) + ' - email
address: ' + EMailAddress + ' , display name: ' + ADisplayName);
result.AddObject(EMailAddress,
TStringObject.Create(ADisplayName));
end;
except
on e: Exception do
dmMain.LogLine('Failed to read email address from recipient table
row with error message: ' + e.Message);
end;
end;
except
on e: Exception do
dmMain.LogLine('Failed to retrieve recipients table with error
message: ' + e.Message);
end;
// Free each element in the pRows buffer
FreeProws(lppRows);
end;
