asked on

Accessing Outlook Calendar from Delphi

Hello,

I have a small app that worked fine in Delphi5. I have ported it to TurboDelphi, and the routine that accesses the appointments in Outlook Calendar no longer works. Specifically, the call to the Item.GetNext for Outlook generates an EOleSysError with an errorcode of 1. try..except blocks DO NOT trap the error. I have gotten the following explanation, but I am having difficulty implementing it....

"Delphi freaks out if anything other than S_OK is returned by a COM method. In this case the error is non-critical (>0) and should be ignored. There are a few other places in OOM that cause the same problem in Delphi:
MailItem.Unread, MailItem.Move, etc.

Normally, you could just wrap the call in to a try..except block, but the exception will prevent you from getting the return value. Either import the type library without using the safecall convention (you would need to handle all HResults explicitly) or call IDspatch.GetIDsOfNames/Invoke explicitly."

I will provide sample code. 500 points to anyone who can make it work without generating an untrappable error. I would ideally like to eliminate variants as well if possible, as they are really slow. I would prefer not to use the sagecall/HResults approach as there are other portions of code that access Outlook as well, and I don't want to have to change this app any more than I have to....
----------------------------------------------------------------------------------------------------------------------------------
procedure TForm1.Button4Click(Sender: TObject);
var
i: Integer;
Outlook, Namespace, Appointment, Calendar: variant;
Created: Boolean;
Accept: Boolean;
MyItems: Variant;

begin

Created := False;

try
Outlook := GetActiveOleObject('outlook.application');
except
Outlook := CreateOleObject('outlook.application');
Created := True;
end;

Namespace := Outlook.GetNamespace('MAPI');
Calendar := Namespace.GetDefaultFolder(olFolderCalendar);

try
Appointment := Calendar.Items.GetFirst;
except
Memo1.Lines.Add('No appointments found');
end;

while VarIsEmpty(Appointment) = False do
begin
Memo1.Lines.Add(Appointment.Subject);

try
Appointment := Calendar.Items.GetNext; // THIS LINE errors out when no more appts exists
except
on E: EOleSysError do
begin
if E.Errorcode > 0 then
ShowMessage(IntToStr(E.ErrorCode));
end;
end;

end;

if Created then
Outlook := unassigned;

bernani

Hi,

Maybe a silly question, but is it a particular reason you don't check if there is an appointment to display before trying to get it ?

if Calendar.Items.count > 0 then
Appointment := Calendar.Items.GetFirst
else
Memo1.Lines.Add('No appointments found');

for j:= 1 to calendar.items.count do
begin
Appointment := Calendar.Items[j];
Memo1.Lines.Add(Appointment.Subject);
end;

It's the same checks to do with MailItem.Unread, MailItem.Move, etc.

I believe it's easier to check if there is at minimum one item to display, move or read before working with it. with item.count you are always sure that you neve go out of bounds.

gspears060598

ASKER

That is a fair question....

I know that I have an appointment. The problem is that the COM interface appears to have changed somewhere between D7 and TurboDelphi. The Items.GetNext will fail when there is no next item/appointment available, and this failure is NOT caught within a try...except block. I cannot simply count the appointments and use a for...next loop because while this will work in the code shown, this will NOT work when you sort/restrict the appointments. For example, if I want all appointments between T1 and T2, (dates) sorted by start date, INCLUDING RECURRING APPOINTMENTS, then the count ALWAYS returns 2 Billion (whatever that specific maxint value is.) This is known, expected behaviour when you use the "include recurring" functionality.

I have been able to get this to work. Here is the code. I will withdraw this question.
In the following code, PM1 is a memobox....

procedure TForm1.BitBtn1Click(Sender: TObject);
var
Outlook, Namespace, Appointment, Calendar: variant;
Recip: Variant; // MultiCalendar Access
fldr: Variant; // MultiCalendar Access
Created: Boolean;

MyItems, ItemCollection: Variant;

Msg: string;
DateRangeStart, DateRangeEnd: TDateTime;
Save_Cursor: TCursor;
RestrictDateFilter: string;
FilterStartDate: string;
FilterEndDate: string;
CurrentDate: TDateTime;
ApptDate: TDateTime;
WeekDayNo: Integer;
StartDateYear, EndDateYear: string;
NeedDateHeader: Boolean;
RP: OLEVariant;
RecurType: string;
sd, ed: string;
T1, T2: DWord;

begin
if MessageDlg('This will dump the raw Outlook appointments to the log. Continue?',
mtConfirmation, [mbYes, mbNo], 0) = mrNo then
exit;

// Get the dump date range....
DateRangeStart := trunc(now - 365);
DateRangeEnd := trunc(now + 365);

sd := DateToStr(DateRangeStart);
ed := DateToStr(DateRangeEnd);

if InputQuery('Debug Dump', 'Start date:', sd) = False then exit;
if InputQuery('Debug Dump', 'End date:', ed) = False then exit;

try
DateRangeStart := StrToDate(sd);
DateRangeEnd := StrToDate(ed);
except
MessageDlg('You have entered an invalid date. Please check the date format', mtError, [mbok], 0);
exit;
end;

MessageDlg('NOTE: This will probably take 15 to 20 seconds.... please be patient....',
mtInformation, [mbOK], 0);

// If here, then we are ready to go....
PageControl.ActivePage := LogTab;
PM1.Clear;

////// START OUTLOOK //////////////////////////////////////////////////
try
Outlook := GetActiveOleObject('outlook.application');
except
Outlook := CreateOleObject('outlook.application');
Created := True;
end;

Namespace := Outlook.GetNamespace('MAPI');
Calendar := Namespace.GetDefaultFolder(olFolderCalendar);

if VarIsEmpty(OutLook) then
PM1.Lines.Add('Unable to access Outlook')
else
PM1.Lines.Add('Outlook accessed');

if VarIsEmpty(NameSpace) then
PM1.Lines.Add('Unable to access MAPI Namespace')
else
PM1.Lines.Add('MAPI Namespace accessed');

if VarIsEmpty(Calendar) then
PM1.Lines.Add('Unable to access Outlook calendar folder')
else
PM1.Lines.Add('Outlook calendar folder accessed');

PM1.Lines.Add('Accessing Outlook Calendar for raw data dump');
Application.ProcessMessages;
Application.ProcessMessages;

PM1.Lines.Add('Total appointment entries found in calendar: ' + IntToStr(Calendar.Items.Count));
PM1.Lines.Add('Filtering dates between ' + DateToStr(DateRangeStart) + ' and ' + DateToStr(DateRangeEnd));
PM1.Lines.Add(' ');

Save_Cursor := Screen.Cursor;
Screen.Cursor := crHourglass; { Show hourglass cursor }

MyItems := Calendar.Items;
MyItems.Sort('[Start]', False);
MyItems.IncludeRecurrences := True;

// Set the filter dates... SECONDS can NOT be shown...
FilterStartDate := FormatDateTime('mmmm dd, yyyy', DateRangeStart);
FilterStartDate := FilterStartDate + ' 12:00 AM';

FilterEndDate := FormatDateTime('mmmm dd, yyyy', DateRangeEnd);
FilterEndDate := FilterEndDate + ' 11:59 PM';

RestrictDateFilter := ('[Start]>' + CHR(34) + FilterStartDate + CHR(34) + 'and ' +
'[Start]<' + CHR(34) + FilterEndDate + CHR(34));

PM1.Lines.Add('Filter is set to');
PM1.Lines.Add(RestrictDateFilter);

Application.ProcessMessages;

PM1.Lines.Add('Preparing to restrict and sort data');
Application.Processmessages;

ItemCollection := MyItems.Restrict(RestrictDateFilter);
ItemCollection.Sort('[Start]', False);

PM1.Lines.Add('Restriction and sorting complete');
PM1.Lines.Add('Beginning to iterate through data');
PM1.Lines.Add('---------------------------------');
Application.Processmessages;

// Try to read the first appoint, or error message if no appointments
T1 := GetTickCount;

try
Appointment := ItemCollection.GetFirst;
except
PM1.Lines.Add('No appointments found');
MessageDlg('Unable to retrieve any appointments in this time frame.',
mtError, [mbOK], 0);
if Created = True then
begin
Application.ProcessMessages;
Outlook.Quit;
end;
Screen.Cursor := Save_Cursor; { Always restore to normal }
exit;
end;

CurrentDate := Trunc(StartDate.Date);
PM1.Lines.Add('--------------------------------------------');
PM1.Lines.Add('');

while VarIsClear(Appointment) = False do
begin
Application.ProcessMessages;

PM1.Lines.BeginUpdate;

PM1.Lines.Add('*** Subject: ' + Appointment.Subject);
StatusBar.Panels[0].Text := Appointment.Subject;
Application.ProcessMessages;

// Get the date of the appt..
ApptDate := Trunc(Appointment.Start);
PM1.Lines.Add(' Start: ' + DateTimeToStr(Appointment.Start) + ' End: ' + DateTimeToStr(Appointment.end));

// Now get recurrance type
RP := Appointment.GetRecurrencePattern;
if Appointment.IsRecurring = True then
recurType := IntToStr(RP.RecurrenceType)
else
recurType := 'Non-recurring';
PM1.Lines.Add(' Recurrency: ' + recurType);

// Get privacy code
PM1.Lines.Add(' Status: ' + IntToStr(Appointment.Sensitivity));

// get all day status
PM1.Lines.Add(' All day event: ' + BoolToStr(Appointment.AllDayEvent));
PM1.Lines.EndUpdate;

try
Appointment := ItemCollection.GetNext;
except
// break;
end;

Application.ProcessMessages;

end;

T2 := GetTickCount;
PM1.Lines.Add('');
PM1.Lines.Add('Processing took: ' + IntToStr(T2 - T1) + ' ms');

Screen.Cursor := Save_Cursor; { Always restore to normal }
PM1.Lines.BeginUpdate;
PM1.Lines.Add(' ');
PM1.Lines.Add('--------------------------------------------------');
PM1.Lines.Add('All appointments from Outlook have been processed.');
PM1.Lines.EndUpdate;

if Created = True then
begin
// Outlook := unassigned
///else
PM1.Lines.Add('Closing Outlook');
Application.ProcessMessages;
Outlook.Quit;
end;

Application.ProcessMessages;

// Build the email subject
EmailSubject := 'Raw Log Dump';
Application.ProcessMessages;
MessageDlg('Processing completed', mtInformation, [mbOK], 0);

end;

ASKER CERTIFIED SOLUTION

PashaMod

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial