unit send_to_outlook;
interface
uses
Windows, Messages, SysUtils, StrUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls, ShellAPI, Grids, ComCtrls, ComObj, ShellCtrls, jpeg;
type
TCalendar =
record
Start:
string;
Ende:
string;
Categories:
string;
Subject:
string;
Body:
string;
// ### Further properties. See MSDN
end;
type
TForm1 =
class(TForm)
LabelDatum: TLabel;
Button1: TButton;
Startzeit: TDateTimePicker;
Endzeit: TDateTimePicker;
LabelStart: TLabel;
LabelEnde: TLabel;
LabelBetreff: TLabel;
LabelKategorie: TLabel;
LabelBeschreibung: TLabel;
Datum: TDateTimePicker;
Betreff: TEdit;
Kategorie: TEdit;
Beschreibung: TMemo;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private-Deklarationen }
public
{ Public-Deklarationen }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
Datum.Date := Date;
end;
procedure OutlookAddCalendar(CalendarFolderPath :
string; Calendar : TCalendar);
const
olFolderCalendars = $00000009;
var
Outlook : OleVariant;
NameSpace : OleVariant;
CalendarsRoot : OleVariant;
CalendarsFolder : OleVariant;
OutlookCalendar : OleVariant;
SubFolderName :
string;
Position : integer;
Found : boolean;
Counter : integer;
TestCalendarFolder : OleVariant;
begin
// Connect to outlook
Outlook := CreateOleObject('
Outlook.Application');
// Get name space
NameSpace := Outlook.GetNameSpace('
MAPI');
// Get root Calendars folder
CalendarsRoot := NameSpace.GetDefaultFolder(olFolderCalendars);
// Iterate to subfolder
CalendarsFolder := CalendarsRoot;
while CalendarFolderPath <> '
'
do
begin
// Extract next subfolder
Position := Pos('
\', CalendarFolderPath);
if Position > 0
then
begin
SubFolderName := Copy(CalendarFolderPath, 1, Position - 1);
CalendarFolderPath := Copy(CalendarFolderPath, Position + 1, Length(CalendarFolderPath));
end
else
begin
SubFolderName := CalendarFolderPath;
CalendarFolderPath := '
';
end;
if SubFolderName = '
'
then
Break;
// Search subfolder
Found := False;
for Counter := 1
to CalendarsFolder.Folders.Count
do
begin
TestCalendarFolder := CalendarsRoot.Folders.Item(Counter);
if LowerCase(TestCalendarFolder.
Name) = LowerCase(SubFolderName)
then
begin
CalendarsFolder := TestCalendarFolder;
Found := True;
Break;
end;
end;
// If not found create
if not Found
then
CalendarsFolder := CalendarsFolder.Folders.Add(SubFolderName);
end;
// Create Calendar item
OutlookCalendar := CalendarsFolder.Items.Add;
// Fill Calendar information
OutlookCalendar.Start := Calendar.Start;
OutlookCalendar.
End := Calendar.Ende;
OutlookCalendar.Categories := Calendar.Categories;
OutlookCalendar.Subject := Calendar.Subject;
OutlookCalendar.Body := Calendar.Body;
// ### Further properties
// Save Calendar
OutlookCalendar.Save;
// Disconnect from outlook
Outlook := Unassigned;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
Ordner:
string;
Calendar: TCalendar;
begin
Ordner := '
Test-Ordner';
Calendar.Start := DateToStr(Datum.DateTime) + '
' + TimeToStr(Startzeit.DateTime);
Calendar.Ende := DateToStr(Datum.DateTime) + '
' + TimeToStr(Endzeit.DateTime);
Calendar.Categories := Kategorie.Text;
Calendar.Subject := Betreff.Text;
Calendar.Body := Beschreibung.Text;
OutlookAddCalendar(Ordner,Calendar);
end;
end.