📄 outlookdatalink.pas
字号:
{-----------------------------------------------------------------------------
Unit Name: OutLookDataLink
Author: Dancemammal
Purpose: Link Gantt Chart to OutLook
History:
-----------------------------------------------------------------------------}
unit OutLookDataLink;
interface
uses
Windows, Classes, ComCtrls, SysUtils, Dialogs,
ComObj, Graphics, Controls, Forms, Variants;
const
olFolderTasks = 13;
type
TOutlookDataLink = class(TObject)
private
MyOlApp: Variant;
MyNameSpace: Variant;
Active: Boolean;
MyOLEObject: string;
MyOLENameSpace: string;
protected
public
constructor Create;
destructor Destroy; override;
function OutlookApplication: Variant;
function OutlookNameSpace: Variant;
function OutlookActiveExplorer: Variant;
procedure ConnectOutlook(Connect: Boolean);
function CurrentUser: string;
function Tasks: Variant;
function CreateTask: Variant;
function Task(Index: Variant): Variant;
function TaskCount: Word;
procedure DeleteTask(MyTask: Variant);
function FindTask(FindWhat: string): Variant;
function TopFolders(Index: Variant): Variant;
published
property Connected: Boolean read Active write ConnectOutlook;
property OLEObject: string read MyOLEObject write MyOLEObject;
property OLENameSpace: string read MyOLENameSpace write MyOLENameSpace;
end;
implementation
procedure TOutlookDataLink.ConnectOutlook(Connect: Boolean);
begin
if Connect then
begin
try
MyOlApp := CreateOleObject(OLEObject);
MyNameSpace := MyOlApp.GetNamespace(OLENameSpace);
except
raise Exception.Create('Outlook registration failed');
end;
end else
begin
MyOlApp := NULL;
MyNameSpace := NULL;
end;
Active := Connect;
end;
function TOutlookDataLink.CurrentUser: string;
begin
if not Active then
raise Exception.Create('No connection to outlook');
try
Result := MyNameSpace.CurrentUser.Name;
except
raise Exception.Create('Cannot import Item');
end;
end;
function TOutlookDataLink.Tasks: Variant;
begin
if not Active then
raise Exception.Create('No connection to outlook');
Result := myNameSpace.GetDefaultFolder(olFolderTasks);
end;
function TOutlookDataLink.Task(Index: Variant): Variant;
begin
if not Active then
raise Exception.Create('No connection to outlook');
try
Result := myNameSpace.GetDefaultFolder(olFolderTasks).Items[Index];
except
raise Exception.Create('Cannot Export Item');
end;
end;
function TOutlookDataLink.TaskCount: Word;
begin
if not Active then
raise Exception.Create('No connection to outlook');
try
Result := myNameSpace.GetDefaultFolder(olFolderTasks).Items.Count;
except
Result := 0;
end;
end;
function TOutlookDataLink.CreateTask: Variant;
var
MyTask: Variant;
begin
if not Active then
raise Exception.Create('No connection to outlook');
try
MyTask := myNameSpace.GetDefaultFolder(olFolderTasks).Items.Add;
Result := MyTask;
except
raise Exception.Create('Cannot create Task');
end;
end;
procedure TOutlookDataLink.DeleteTask(MyTask: Variant);
begin
if not Active then
raise Exception.Create('No connection to outlook');
try
MyTask.Delete;
except
raise Exception.Create('Cannot delete Task');
end;
end;
function TOutlookDataLink.FindTask(FindWhat: string): Variant;
begin
if not Active then
raise Exception.Create('No connection to outlook');
try
Result := myNameSpace.GetDefaultFolder(olFolderTasks).Items.Find(FindWhat);
except
raise Exception.Create('Error finding Task');
end;
end;
function TOutlookDataLink.OutlookApplication: Variant;
begin
Result := MyOlApp;
end;
function TOutlookDataLink.OutlookNameSpace: Variant;
begin
Result := MyNameSpace;
end;
function TOutlookDataLink.OutlookActiveExplorer: Variant;
begin
Result := MyOlApp.ActiveExplorer;
end;
function TOutlookDataLink.TopFolders(Index: Variant): Variant;
begin
if not Active then
raise Exception.Create('No connection to outlook');
Result := myNameSpace.Folders.Item(Index);
end;
constructor TOutlookDataLink.Create;
begin
inherited Create;
if Active then ConnectOutlook(True);
if OLEObject = '' then OLEObject := 'Outlook.Application';
if OLENameSpace = '' then OLENameSpace := 'MAPI';
end;
destructor TOutlookDataLink.Destroy;
begin
ConnectOutlook(False);
inherited Destroy;
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -