PhysiologyWeb Logo  Search
PhysiologyWeb Loading...

Delphi Code - Get Microsoft Outlook Calendar Meetings and Appointments within a Date Range
Here is a simple Delphi procedure that programmatically retrieves all Microsoft Outlook calendar meetings and appointments within a date range. 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 Excel automation solutions, see Microsoft Outlook Automation with Delphi.
procedure TForm1.GetMicrosoftOutlookCalendarAppointmentsWithinADateRange(Sender: TObject);
var
Count: Integer;
StartDate, EndDate: TDate;
StartDateString, EndDateString, OutlookFindString: String;
OutlookApplication, OutlookNameSpace, OutlookFolder, OutlookFolderAppointmentItems, OutlookAppointmentItem: Variant;
begin
//be sure ComObj and Variants units are included in the "uses" clause

Count := 0;

StartDate := StrToDate('8/14/2022'); //start of date window
EndDate := StrToDate('8/20/2022'); //end date for search window
EndDate := EndDate + 1; //make the search inclusive for the specified window

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
//add code to handle calendar appointments as desired.
//here we capture a summary of the calendar appointments found
//be sure a Memo1 VCL object exists
Count := Count + 1;
Memo1.Lines.Add(IntToStr(Count) + #9 + OutlookAppointmentItem.Subject + #9 + DateTimeToStr(OutlookAppointmentItem.Start) + #9 + DateTimeToStr(OutlookAppointmentItem.End) + #9 + BooleanToString(OutlookAppointmentItem.IsRecurring) + #9 + IntToStr(OutlookAppointmentItem.RecurrenceState));
//referece
//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: Sunday, August 14, 2022