Navigation Menu Search PhysiologyWeb
PhysiologyWeb Logo Search PhysiologyWeb
   
— share —
Share on Facebook    Share on X    Share on LinkedIn    Share on Pinterest    Share on Reddit    Email    Copy URL
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
Last updated: Tuesday, March 18, 2025
— share —
Share on Facebook    Share on X    Share on LinkedIn    Share on Pinterest    Share on Reddit    Email    Copy URL