I'm trying to do advanced search in Outlook with Delphi. I'm actually trying to make the code displayed in https://learn.microsoft.com/en-us/office/vba/api/outlook.application.advancedsearch to work in Delphi 10.2 and up. Outlook (office) versions I have is 2019 and 2021. A search is performed in both inbox and sent folders. However I cannot make it work
Var
Outlook, oNameSpace, Attachment, MySearch, MyTable, nextRow, rsts : OLEVariant;
Inbox : OLEVariant;
i, j, iNbMail, iNbAttach: Integer;
Mail, EmailAddress, UnReadFlag, SaveName, AParent : Variant;
AMessageID, Scope, AFilter, AStr: String;
begin
try
//create Outlook OLE
Outlook := CreateOleObject('Outlook.Application');
except
Outlook := Null;
//add error/exception handling code as desired
end;
try
oNameSpace := Outlook.GetNamespace('MAPI');
AStr:='test';
// Search in both inbox and sent folders (works)
Scope := QuotedStr(Outlook.Session.GetDefaultFolder(olFolderInbox).FolderPath)
+ ',' + QuotedStr(Outlook.Session.GetDefaultFolder(olFolderSentMail).FolderPath);
// The IsInstantSearchEnabled condition doesn't seem to work
If Outlook.Session.DefaultStore.IsInstantSearchEnabled Then
AFilter := Char(34) + 'urn:schemas:httpmail:subject ' + Char(34) + ' ci_phrasematch '+ (AStr)
Else
AFilter := Char(34) + 'urn:schemas:httpmail:subject ' + Char(34) + ' like ' + (AStr);
// Filter condition with like works
AFilter := 'urn:schemas:httpmail:subject like ''%' + AStr + '%''';
m_SearchComplete:=False;
MySearch := Outlook.AdvancedSearch(Scope, AFilter, True, 'MySearch');
While m_SearchComplete <> True do
begin
If MySearch.Tag = 'MySearch' Then
begin
m_SearchComplete := True;
End;
Application.ProcessMessages;
end;
rsts := MySearch.Results;
ShowMessage('Count=' + VarToStr(rsts.Count));
Application.ProcessMessages;
MyTable := MySearch.GetTable;
ShowMessage('Count=' + VarToStr(MyTable.GetRowCount));
While Not MyTable.EndOfTable do
begin
nextRow := MyTable.GetNextRow ;
//ShowMessage(nextRow.Subject); // doesn't work
ShowMessage ('Found');
end;
My problems are the following:
- I don't know who to use the Application.AfvancedSearchComplete event in Delphi. I created a loop which searches the AdvancedSearch.Tag in order to check if the search is completed, that is Application.AfvancedSearchComplete event supposed to do. This code works sometimes and many times doesn't return any reaches. I put some message boxes and some sleep functions in order to may it work sometimes. I also tied with open and closed outlook.
- I didn't manage to get the value of the columns of the search results e.g. the subject.
Can anyone please help me with these issues?
Best Regards, Manolis Perrakis
Hi, after thorough search in many sites and posts and components I came up that the proper solution is to use the code displayed in Outlook Object Model - Detecting if email has been sent in which it creates a wrapper and can override/replace an event of a MailItem with a custom procedure. This code is excuted correctly in Delhi 10.2 and actually displays a message when an meil is sent which is actually great. (Many thanks to Sertac Akyuz)
I tried to alter the code in order to replace the procedure AdvancedSearchComplete which exists in the ApplicationEvents_10 dispinterface in outllok2010.pas I also created the Outlook_TLB.pas for the outlook 2016 type library using tlibimp.exe from the code diplayed in https://en.delphipraxis.net/topic/1281-importing-excel2016-type-library-into-delphi/. AdvancedSearchComplete also exists in Outlook_TLB.pas.
My code is like this:
TForm1 = class(TForm, IDispatch)
...
Var
FCookie: Integer;
FMailItem: OleVariant;
FSearch: OleVariant;
//procedure MailSent;
procedure AdvancedSearchComplete (SearchObject:OLeVariant);
protected
function QueryInterface(const IID: TGUID; out Obj): HResult; override;
function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult;
stdcall;
public
{ Public declarations }
Var
m_SearchComplete : Boolean;
end;
Const
DIID_ApplicationEvents_10: TGUID = '{0006300E-0000-0000-C000-000000000046}';
AdvSearchCompleteDispID = 64106;
function TForm1.QueryInterface(const IID: TGUID; out Obj): HResult;
begin
{if IsEqualGUID(IID, DIID_ItemEvents) and GetInterface(IDispatch, Obj) then
Result := S_OK
else
Result := inherited QueryInterface(IID, Obj); }
if IsEqualGUID(IID, DIID_ApplicationEvents_10) and GetInterface(IDispatch, Obj) then
Result := S_OK
else
Result := inherited QueryInterface(IID, Obj);
end;
function TForm1.Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult;
begin
Result := S_OK;
//if DispID = SendItemDispID then MailSent;
if DispID = AdvSearchCompleteDispID Then AdvancedSearchComplete (FSearch);
end;
procedure TForm1.cxButton8Click(Sender: TObject);
Var
Outlook, oNameSpace, MySearch, MyTable, nextRow, rsts : OLEVariant;
Scope, Scope1, AFilter, AStr, ATag: String;
CPContainer: IConnectionPointContainer;
ConnectionPoint: IConnectionPoint;
begin
try
Outlook := CreateOleObject('Outlook.Application');
except
Outlook := Null;
end;
try
oNameSpace := Outlook.GetNamespace('MAPI');
AStr:='test';
Scope := QuotedStr(Outlook.Session.GetDefaultFolder(olFolderInbox).FolderPath)
+ ',' + QuotedStr(Outlook.Session.GetDefaultFolder(olFolderSentMail).FolderPath);
AFilter := 'urn:schemas:httpmail:subject like ''%' + AStr + '%''';
m_SearchComplete:=False;
// I use a dummy creation of the FSearch variable in order to be used in the Supports condition
Scope1 := QuotedStr( Outlook.Session.GetDefaultFolder(olFolderOutbox).FolderPath);
FSearch := Outlook.AdvancedSearch(Scope1, AFilter, False, 'xxx');
// ** Problem it doesn't return true to supports condition for the FSearch variable
// which source be typeof a Search Object
if Supports(FSearch, IConnectionPointContainer, CPContainer) then begin
CPContainer.FindConnectionPoint(DIID_ApplicationEvents, ConnectionPoint);
if Assigned(ConnectionPoint) then
ConnectionPoint.Advise(Self, FCookie);
CPContainer := nil;
end;
FSearch := Outlook.AdvancedSearch(Scope, AFilter, True, 'MyAdvancedSearch');
if Assigned(ConnectionPoint) then begin
ConnectionPoint.Unadvise(FCookie);
ConnectionPoint := nil;
end;
I changed the DIID_ApplicationEvents to DIID_ApplicationEvents_10 and again the support condition returns false
Adding the interface section from Outlook2010 and Outlook_TLB
DIID_ApplicationEvents_10: TGUID = '{0006300E-0000-0000-C000-000000000046}';
// *********************************************************************//
// DispIntf: ApplicationEvents_10
// Flags: (4096) Dispatchable
// GUID: {0006300E-0000-0000-C000-000000000046}
// *********************************************************************//
ApplicationEvents_10 = dispinterface
['{0006300E-0000-0000-C000-000000000046}']
function ItemSend(const Item: IDispatch; var Cancel: WordBool): HResult; dispid 61442;
function NewMail: HResult; dispid 61443;
function Reminder(const Item: IDispatch): HResult; dispid 61444;
function OptionsPagesAdd(const Pages: PropertyPages): HResult; dispid 61445;
function Startup: HResult; dispid 61446;
function Quit: HResult; dispid 61447;
procedure AdvancedSearchComplete(const SearchObject: Search); dispid 64106;
procedure AdvancedSearchStopped(const SearchObject: Search); dispid 64107;
procedure MAPILogonComplete; dispid 64144;
end;
So my main problem is why the Supports(FSearch, IConnectionPointContainer, CPContainer) doesn't return true. And also how these functions can be modified in order to work for 2 or more events e.g. for the Send and AdvancedSearchComplete events . (Or is there a way to reach Sertac Akyuz and hopefully can and wants to help)
Update The first problem is solved if Supports(FSearch, IConnectionPointContainer, CPContainer) then
should be
if Supports(Outlook, IConnectionPointContainer, CPContainer) then
It should search if outlook object is supported and not the result object of the advancedSearch. Now it finds the connection point but it doesnot fire the AdvancedSearchComplete event. I'm searching for this and will return to reply to myself.
