PDA

Ver la Versión Completa : Pasar citas a Outlook 2003


aircraft
03-07-2006, 13:51:26
Hola, estoy haciendo un programa para control de visitas a clientes y me gustaria que las visitas que programa el comercial le pasaran automaticamente a las citas del outlook. El problema es que estoy haciendo pruebas con un codigo pero me parece que no funciona bien en el Outlook 2003. Solo XP y 2000. Los comerciales tienen un poco de todo, así que me gustaria que el codigo funcionara con todas las versiones.

Ahi va el codigo:


uses ComObj;

procedure CreateNewAppointment;
const
olAppointmentItem = $00000001;

olImportanceLow = 0;
olImportanceNormal = 1;
olImportanceHigh = 2;

{to find a default Contacts folder}
function GetCalendarFolder(folder: OLEVariant): OLEVariant;
var
i: Integer;
begin
for i := 1 to folder.Count do
begin
if (folder.Item[i].DefaultItemType = olAppointmentItem) then
begin
Result := folder.Item[i];
break
end
else
Result := GetCalendarFolder(folder.Item[i].Folders);
end;
end;

var
outlook, ns, folder, appointment: OLEVariant;
begin
{initialize an Outlook}
outlook := CreateOLEObject('Outlook.Application');
{get MAPI namespace}
ns := outlook.GetNamespace('MAPI');
{get a default Contacts folder}
folder := GetCalendarFolder(ns.Folders);
{if Contacts folder is found}
if not VarIsNull(folder) then
begin
{create a new item}
appointment := folder.Items.Add(olAppointmentItem);
{define a subject and body of appointment}
appointment.Subject := 'new appointment';
appointment.Body := 'call me tomorrow';

{duration: 10 days starting from today}
appointment.Start := Now();
appointment.End := Now()+10; {10 days for execution}
appointment.AllDayEvent := 1; {all day event}

{set reminder in 20 minutes}
appointment.ReminderMinutesBeforeStart := 20;
appointment.ReminderSet := 1;

{set a high priority}
appointment.Importance := olImportanceHigh;

{to save an appointment}
appointment.Save;

{to display an appointment}
appointment.Display(True);

{to print a form}
appointment.PrintOut;
end;

{to free all used resources}
folder := UnAssigned;
ns := UnAssigned;
outlook := UnAssigned
end;


Muchas Gracias de antemano.