Here is a simple Delphi procedure that programmatically retrieves all Microsoft Outlook calendar meetings and appointments within a date range. It then shows how to search for specific meetings and appointments based on a number of criteria. Meetings and appointments can be searched by title, subject, body, location, date, time, required attendees, optional attendees, how recipients have responded to the calendar invitation (e.g., tentatively accepted, accepted, declined, not responded), and appointments without attendees. The examples included in this code can be used to build a very sophisticated search engine for Microsoft Outlook calendar meetings and appointments. The code works well whether or not Outlook is already open. However, please note that the code will not work if Outlook is closed, and your installed Outlook requires any form of authentication upon launching the program. The most relevant parts of the code are highlighted. Comments are included to explain the code. If you copy and paste the code into your program, be sure to change the form and procedure names to match your setup. For additional Outlook automation solutions, see Microsoft Outlook Automation with Delphi.
 |
 |
 |
 |
 |
— share —
procedure TForm1.SearchMicrosoftOutlookCalendarMeetingsAndAppointments(Sender: TObject);
var
StartHour, StartMinute, StartSecond, StartMilliSecond, EndHour, EndMinute, EndSecond, EndMilliSecond: Word;
Count, R: Integer;
StartDate, EndDate, TargetDate: TDate;
StartDateString, EndDateString, OutlookFindString: String;
Found: Boolean;
OutlookApplication, OutlookNameSpace, OutlookFolder, OutlookFolderAppointmentItems, OutlookAppointmentItem: Variant;
begin
//be sure ComObj and Variants units are included in the "uses" clause
//be sure StrUtils is included in the "uses" clause
StartHour := 0;
StartMinute := 0;
StartSecond := 0;
StartMilliSecond := 0;
EndHour := 0;
EndMinute := 0;
EndSecond := 0;
EndMilliSecond := 0;
Count := 0;
R := 0;
StartDate := StrToDate('10/1/2022'); //start of date window
EndDate := StrToDate('10/31/2022'); //end date for search window
EndDate := EndDate + 1; //make the search inclusive for the specified window
TargetDate := 0;
Found := False;
StartDateString := FormatDateTime('ddddd h:nn AMPM', StartDate);
EndDateString := FormatDateTime('ddddd h:nn AMPM', EndDate);
OutlookFindString := '([Start] >= "' + StartDateString + '" and [End] <= "' + EndDateString + '") or ' +
'([Start] <= "' + StartDateString + '" and [End] >= "' + EndDateString + '") or ' +
'([Start] <= "' + StartDateString + '" and [End] >= "' + StartDateString + '" and [End] <= "' + EndDateString + '") or ' +
'([Start] >= "' + StartDateString + '" and [Start] <= "' + EndDateString + '" and [End] >= "' + EndDateString + '")';
OutlookApplication := Null;
OutlookNameSpace := Null;
OutlookFolder := Null;
OutlookFolderAppointmentItems := Null;
OutlookAppointmentItem := Null;
try
//create Outlook OLE
OutlookApplication := CreateOleObject('Outlook.Application');
except
OutlookApplication := Null;
//add error/exception handling code as desired
end;
If VarIsNull(OutlookApplication) = False then
begin
try
OutlookNameSpace := OutlookApplication.GetNameSpace('MAPI');
OutlookNameSpace.Logon('', '', False, True);
OutlookFolder := OutlookNameSpace.GetDefaultFolder(9); //olFolderCalendar = 9
OutlookFolderAppointmentItems := OutlookFolder.Items;
OutlookFolderAppointmentItems.IncludeRecurrences := True; //False (not recommended) returns master items, but not recurrences
OutlookFolderAppointmentItems.Sort('[Start]', False); //True = descending; False = ascending
//references
//https://docs.microsoft.com/en-us/office/vba/api/Outlook.Items.IncludeRecurrences
//https://docs.microsoft.com/en-us/office/vba/api/outlook.items.sort
try
OutlookAppointmentItem := Null;
OutlookAppointmentItem := OutlookFolderAppointmentItems.Find(OutlookFindString);
//reference
//https://docs.microsoft.com/en-us/office/vba/api/outlook.items.find
repeat
If (VarIsNull(OutlookAppointmentItem) = False) and (VarIsEmpty(OutlookAppointmentItem) = False) then
begin
//be sure a Memo1 VCL object exists
Found := False;
//search for appointment/meeting titles/subjects
If (AnsiContainsText(OutlookAppointmentItem.Subject, 'lunch') = True) then Found := True; //change search word/phrase as appropriate
//Note: AnsiContainsText is case insensitive, use AnsiContainsStr for case sensitive searches, be sure to include StrUtils in the "uses" clause
//search for words/phrases in body of appointments/meetings
If (AnsiContainsText(OutlookAppointmentItem.Body, 'please') = True) then Found := True; //change search word/phrase as appropriate
//Note: AnsiContainsText is case insensitive, use AnsiContainsStr for case sensitive searches, be sure to include StrUtils in the "uses" clause
//search for appointments/meetings on a particular date
TargetDate := StrToDate('10/27/2022'); //change target date as appropriate
If DateOf(OutlookAppointmentItem.Start) = TargetDate then Found := True;
//search for appointments/meetings within a time window
DecodeTime(OutlookAppointmentItem.Start, StartHour, StartMinute, StartSecond, StartMilliSecond);
DecodeTime(OutlookAppointmentItem.End, EndHour, EndMinute, EndSecond, EndMilliSecond);
If (StartHour >= 16) and (EndHour <= 17) then Found := True; //change start and end hours as appropriate
//Note:
//Hour = 0..23
//Minute = 0..59
//Second = 0..59
//MilliSecond = 0..999
//search for required attendees
If (AnsiContainsText(OutlookAppointmentItem.RequiredAttendees, 'dave') = True) then Found := True; //change search name as appropriate
//Note: AnsiContainsText is case insensitive, use AnsiContainsStr for case sensitive searches, be sure to include StrUtils in the "uses" clause
//search for optional attendees
If (AnsiContainsText(OutlookAppointmentItem.OptionalAttendees, 'susan') = True) then Found := True; //change search name as appropriate
//Note: AnsiContainsText is case insensitive, use AnsiContainsStr for case sensitive searches, be sure to include StrUtils in the "uses" clause
//search for recipients who have tentatively accepted the appointment/meeting invitation
For R := 1 to OutlookAppointmentItem.Recipients.Count do
begin
If OutlookAppointmentItem.Recipients.Item(R).MeetingResponseStatus = 2 then //olResponseTentative = 2
begin
Found := True;
Memo1.Lines.Add(OutlookAppointmentItem.Recipients.Item(R).Name);
end;
end;
//search for recipients who have accepted the appointment/meeting invitation
For R := 1 to OutlookAppointmentItem.Recipients.Count do
begin
If OutlookAppointmentItem.Recipients.Item(R).MeetingResponseStatus = 3 then //olResponseAccepted = 3
begin
Found := True;
Memo1.Lines.Add(OutlookAppointmentItem.Recipients.Item(R).Name);
end;
end;
//search for recipients who have declined the appointment/meeting invitation
For R := 1 to OutlookAppointmentItem.Recipients.Count do
begin
If OutlookAppointmentItem.Recipients.Item(R).MeetingResponseStatus = 4 then //olResponseDeclined = 4
begin
Found := True;
Memo1.Lines.Add(OutlookAppointmentItem.Recipients.Item(R).Name);
end;
end;
//search for recipients who have not responded to the appointment/meeting invitation
For R := 1 to OutlookAppointmentItem.Recipients.Count do
begin
If OutlookAppointmentItem.Recipients.Item(R).MeetingResponseStatus = 5 then //olResponseNotResponded = 5
begin
Found := True;
Memo1.Lines.Add(OutlookAppointmentItem.Recipients.Item(R).Name);
end;
end;
//search for appointment/meeting locations
If (AnsiContainsText(OutlookAppointmentItem.Location, 'conference room') = True) then Found := True; //change the location as appropriate
//Note: AnsiContainsText is case insensitive, use AnsiContainsStr for case sensitive searches, be sure to include StrUtils in the "uses" clause
//search for cancelled appointments/meetings
If (OutlookAppointmentItem.MeetingStatus = 5) or (OutlookAppointmentItem.MeetingStatus = 7) or (AnsiContainsText(OutlookAppointmentItem.Subject, 'canceled') = True) then Found := True;
//olMeetingCanceled = 5
//olMeetingReceivedAndCanceled = 7
//search for appointment items without attendees
If OutlookAppointmentItem.MeetingStatus = 0 then Found := True;
//olNonMeeting = 0
If Found = True then
begin
Count := Count + 1;
Memo1.Lines.Add(IntToStr(Count) + #9 + OutlookAppointmentItem.Subject + #9 + DateTimeToStr(OutlookAppointmentItem.Start) + #9 + DateTimeToStr(OutlookAppointmentItem.End) + #9 + OutlookAppointmentItem.Location + #9 + BooleanToString(OutlookAppointmentItem.IsRecurring) + #9 + IntToStr(OutlookAppointmentItem.RecurrenceState));
end;
//reference
//https://docs.microsoft.com/en-us/office/vba/api/outlook.appointmentitem
end;
OutlookAppointmentItem := Unassigned;
OutlookAppointmentItem := OutlookFolderAppointmentItems.FindNext;
//reference
//https://docs.microsoft.com/en-us/office/vba/api/outlook.items.findnext
until (VarIsNull(OutlookAppointmentItem) = True) or (VarIsEmpty(OutlookAppointmentItem) = True);
except
//add error/exception handling code as desired
end;
finally
OutlookAppointmentItem := Unassigned;
OutlookFolderAppointmentItems := Unassigned;
OutlookFolder := Unassigned;
OutlookNameSpace := Unassigned;
OutlookApplication := Unassigned;
end;
end;
end;
Posted: Saturday, October 22, 2022
Last updated: Tuesday, March 18, 2025
Last updated: Tuesday, March 18, 2025
— share —