Outlook对象模型结构如图1.31所示,最顶层的对象是Application,通过Application 对象可以使用其他所有的Outlook对象,另外Application 是唯一可以用CreateOleObject 函数创建的Outlook对象。下一个要说的是NameSpace 对象,它提供了对数据源的存取,在Outlook 98中MAPI消息存储是唯一的数据源。
MAPIFolders集合对应一组MAPI文件夹,也就是一组MAPIFolder对象。每个MAPIFolder对象还包含一个Folders集 合,每个集合中还包含一个管理Item对象的Items集合。图1.32是一个Delphi程序,它显示了MAPIFolders集合以及个人文件夹中的 Folders集合和其中联系人目录的Items的内容。程序代码如下:
图1.32
procedure TForm1.OpenBtnClick(Sender: TObject);
var
OutlookApp, Mapi,
Contacts, Personal : Variant;
I: Integer;
begin
{ 获取Outlook Application 对象 }
OutlookApp := CreateOleObject('Outlook.Application');
{ 获取 MAPI NameSpace对象 }
Mapi := OutlookApp.GetNameSpace('MAPI');
{ 遍历MAPI 目录集合并添加目录名到列表框中}
for I := 1 to Mapi.Folders.Count do
MapiList.Items.Add(Mapi.Folders(I).Name);
{ 获取个人文件夹的目录集合}
Personal := Mapi.Folders('个人文件夹');
{ 遍历个人文件夹的目录,并添加目录名到列表框中去 }
for I := 1 to Personal.Folders.Count do
PersonalList.Items.Add(Personal.Folders(I).Name);
{ 获取联系人目录}
Contacts := Personal.Folders('联系人');
{ 获取联系人目录中的联系人人名列表 }
for I := 1 to Contacts.Items.Count do
ContactsList.Items.Add(Contacts.Items(I).FullName);
{ 关闭 Outlook. }
OutlookApp := Unassigned;
end;
这里我们像VB那样使用后期绑定来调用Outlook。CreateOleObject 使用Outlook.Application (Outlook的类名)作为参数调用加载Outlook服务器并返回一个对Application对象的引用。通过Application对象可以获得 对其他Outlook对象的引用。调用Application对象的GetNameSpace方法会返回NameSpace对象(注意调用参数为 MAPI)。通过NameSpace 对象,代码遍历了MAPIFolders 集合然后添加了每个目录的名字到MapiList列表框。
正如在图1.32中看到的,MAPIFolders集合中包含有一个个人文件夹,接下来代码就获得了对个人文件夹的引用Personal := Mapi.Folders('个人文件夹');然后是再用一个循环获得个人文件夹中的全部目录名,最后是获得联系人目录,并由Items 集合获得全部联系人目录中的人名(通过FullName属性获得)。
很明显要想掌握控制Outlook的方法,我们必须清楚Outlook的对象继承关系以及每个对象的属性、方法和事件。Outlook提供了一个帮助文件VBAOUTL.HLP,其中包括了相关信息。
下面的代码演示了如何搜索联系人目录,并把内容复制到一个数据库中:
procedure TLoadTableForm.LoadBtnClick(Sender: TObject);
var
OutlookApp, Mapi,
ContactItems, CurrentContact: Variant;
begin
OutlookApp := CreateOleObject('Outlook.Application');
Mapi := OutlookApp.GetNameSpace('MAPI');
{ 获取联系人目录的Items集合 }
ContactItems := Mapi.Folders('个人文件夹').Folders('联系人').Items;
{ 加载到数据库中 }
with ContactTable do
begin
EmptyTable;
Open;
DisableControls;
CurrentContact := ContactItems.Find('[CompanyName] = ' +
QuotedStr('Borland International'));
while not VarIsEmpty(CurrentContact) do
begin
Insert;
FieldByName('EntryId').AsString :=
CurrentContact.EntryId;
FieldByName('LastName').AsString :=
CurrentContact.LastName;
FieldByName('FirstName').AsString :=
CurrentContact.FirstName;
FieldByName('CompanyName').AsString :=
CurrentContact.CompanyName;
FieldByName('BusAddrStreet').AsString :=
CurrentContact.BusinessAddressStreet;
FieldByName('BusAddrPOBox').AsString :=
CurrentContact.BusinessAddressPostOfficeBox;
FieldByName('BusAddrCity').AsString :=
CurrentContact.BusinessAddressCity;
FieldByName('BusAddrState').AsString :=
CurrentContact.BusinessAddressState;
FieldByName('BusAddrPostalCode').AsString :=
CurrentContact.BusinessAddressPostalCode;
FieldByName('BusinessPhone').AsString :=
CurrentContact.BusinessTelephoneNumber;
Post;
CurrentContact := ContactItems.FindNext;
end; // while
EnableControls;
end; // with
{ 关闭Outlook }
OutlookApp := Unassigned;
end;
上面代码运行的基本步骤同前面的一样,不同之处在于先获取联系人目录的Items集合,然后调用Find 方法根据属性的组合来定位集合中特殊的项目,比如:
CurrentContact := ContactItems.Find(' [CompanyName] = ' +
QuotedStr('Borland International'));
就是查找CompanyName 属性为Borland International的联系人。如果没有找到匹配的联系人,CurrentContact就为空值。while循环利用FindNext来遍历并匹配联系人,并把联系人的全部属性插入到数据库中。
创建新的联系人目录和记录也非常简单,下面的代码可以复制全部的Borland公司雇员联系信息到一个新的目录:
procedure TCreateFolderFrom.CreateBtnClick(Sender: TObject);
const
olFolderContacts = 10;
olContactItem = 2;
var
OutlookApp, Mapi,
NewContact, BorlandContacts,
ContactItems, CurrentContact: Variant;
I, ToRemove: Integer;
begin
OutlookApp := CreateOleObject('Outlook.Application');
Mapi := OutlookApp.GetNameSpace('MAPI');
ContactItems := Mapi.Folders('个人文件夹').Folders('联系人').Items;
{ 删除测试文件夹 }
ToRemove := 0;
for I := 1 to Mapi.Folders('Personal Folders').Folders.Count do
if Mapi.Folders('个人文件夹').Folders(I).Name ='Borland 联系人' then
begin
ToRemove := I;
Break;
end; // if
if ToRemove <> 0 then
Mapi.Folders('Personal Folders').Folders.Remove(ToRemove);
{ 创建新的文件夹 }
Mapi.Folders('个人文件夹').Folders.Add('Borland 联系人', olFolderContacts);
BorlandContacts := Mapi.Folders('Personal Folders').Folders('Borland Contacts');
{ 添加联系人到新的目录 }
CurrentContact := ContactItems.Find('[CompanyName] = ' +
QuotedStr('Borland International'));
while not VarIsEmpty(CurrentContact) do
begin
{ 添加新的项目 }
NewContact := BorlandContacts.Items.Add;
{ 设定属性 }
NewContact.FullName := 'John Doe';
NewContact.LastName := CurrentContact.LastName;
NewContact.FirstName := CurrentContact.FirstName;
NewContact.CompanyName := CurrentContact.CompanyName;
NewContact.BusinessAddressStreet :=
CurrentContact.BusinessAddressStreet;
NewContact.BusinessAddressPostOfficeBox :=
CurrentContact.BusinessAddressPostOfficeBox;
NewContact.BusinessAddressCity :=
CurrentContact.BusinessAddressCity;
NewContact.BusinessAddressState :=
CurrentContact.BusinessAddressState;
NewContact.BusinessAddressPostalCode :=
CurrentContact.BusinessAddressPostalCode;
NewContact.BusinessTelephoneNumber :=
CurrentContact.BusinessTelephoneNumber;
{ 保存记录 }
NewContact.Save;
{ 查找联系人目录中下一个记录}
CurrentContact := ContactItems.FindNext;
end; // while
OutlookApp := Unassigned;
end;
上面的代码流程就是先在Folders 集合中查找Borland 联系人目录,如果找到了就调用Folders 的Remove方法删除之。然后调用Folders 对象的Add 方法创建一个新的Borland 联系人文件夹。Add方法需要两个参数:第一个是要创建的目录名;第二个是文件夹类型(可以是olFolderCalendar、 olFolderContacts、olFolderInbox、olFolderJournal、olFolderNotes或 olFolderTasks类型)。
接下来调用联系人目录的Items对象的Find方法来定位Borland雇员的信息记录。然后调用新建的Borland联系人目录的Items对象的Add方法来添加在联系人目录中找到的记录。最后调用新添记录的Save方法来保存添加的信息。
其他Outlook对象
个人文件夹的Folders 集合还包括下列文件夹:已删除邮件;收件箱;发件箱;已发送邮件;日历;日记;便笺;任务;草稿。
我们可以使用类似的方法来操作任意对象的Items 集合,它们的区别只是集合项目的属性不同,下面的代码演示了如何把约会中的全部起始时间定为大于99/04/27,并且把全天约会的信息复制到数据库的方 法。注意这里使用比前面要复杂的查找表达式,查找表达式支持>,<,>=,<=,=和<>操作符以及and,or和 not逻辑操作符。
procedure TLoadTableForm.LoadBtnClick(Sender: TObject);
var
OutlookApp, Mapi,
ApptItems, CurrentAppt: Variant;
begin
OutlookApp := CreateOleObject('Outlook.Application');
Mapi := OutlookApp.GetNameSpace('MAPI');
pptItems := Mapi.Folders('Personal Folders').Folders('Calendar').Items;
with ApptTable do
begin
EmptyTable;
Open;
DisableControls;
CurrentAppt := ApptItems.Find('[Start] > ' +
"4/27/99" and [AllDayEvent] = True');
while not VarIsEmpty(CurrentAppt) do
begin
Insert;
FieldByName('Start').AsDateTime := CurrentAppt.Start;
FieldByName('Subject').AsString := CurrentAppt.Subject;
FieldByName('End').AsDateTime := CurrentAppt.End;
FieldByName('Busy').AsBoolean := CurrentAppt.BusyStatus;
Post;
CurrentAppt := ApptItems.FindNext;
end; // while
EnableControls;
end; // with
OutlookApp := Unassigned;
end;
邮件查看器
毫无疑问,Outlook最大的用处还是在于它的邮件处理功能,通过自动化可以方便地使用Outlook强大的功能,下面就来编写一个邮件查看器。首 先新建一个项目,然后在窗体上放置一个TOutLine和 TButton。接着声明一个TItem类用来保存对邮件的引用,类定义如下:
TItem = class(TObject)
Letter: OleVariant;
name: string;
end;
在窗体类声明的public部分添加下列变量:
public
{ Public declarations }
OlApp, NameSpace, root: OleVariant;
List: Tlist;
Item: TItem;
icount: integer;
end;
然后在窗体的Oncreate事件中初始化TList用来维护邮件列表:
procedure TForm1.FormCreate(Sender: TObject);
begin
List := TList.Create;
Item := TItem.Create;
icount := 0;
end;
然后编写Button的onClick事件,来建立文件夹树视图:
procedure TForm1.Button1Click(Sender: TObject);
procedure scan(ol: TOutline; root: OleVariant; s: string);
var
i, j, k: integer;
bcount, rcount: integer;
branch, MAPIFolder: olevariant;
line: string;
begin
line := '';
rcount := root.count;
for i := 1 to rcount do
begin
line := s + root.item[i].name;
ol.Lines.Add(line);
List.Add(TItem.Create);
Item := List.items[List.count - 1];
Item.name := 'Folder';
branch := root.item[i].folders;
bcount := branch.count;
MAPIFolder := Namespace.GetFolderFromId(root.item[i].EntryID,
root.item[i].StoreID);
if MAPIFolder.Items.count > 0 then
for j := 1 to MAPIFolder.Items.count do
begin
ol.Lines.Add(s + ' ' + MAPIFolder.Items[j].subject);
List.Add(TItem.Create);
Item := List.items[List.count - 1];
Item.name := 'File';
Item.Letter := MAPIFolder.Items[j];
end;
if bcount > 0 then
begin
scan(ol, branch, s + ' ');
end;
end;
end;
begin
oline_outlook.Lines.Clear;
OlApp := CreateOleObject('Outlook.Application');
Namespace := OlApp.GetNameSpace('MAPI');
root := Namespace.folders;
scan(oline_outlook, root, '');
end;
首先获得文件夹集合,然后在for循环中扫描每个子文件夹,添加信息,如果还有下级子目录,就递归调用:
if bcount > 0 then
begin
scan(ol, branch, s + ' ');
end;
当双击时,需要显示邮件内容,编写OutLine的doubleClick事件,用Showmessage显示邮件内容:
procedure TForm1.oLine_OutLookDblClick(Sender: TObject);
begin
Item := List.items[oline_outlook.SelectedItem - 1];
//body对应邮件内容
if Item.name = 'File' then ShowMessage(Item.Letter.Body);
end;
最后不能忘了在退出程序时释放资源,编写窗体的OnCloseQuery事件处理函数:
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
var
i: integer;
begin
for i := List.Count - 1 downto 0 do
begin
Item := List.Items[i];
图1.33
Item.Free;
end;
List.Free;
end;
最后的程序运行结果如图1.33所示。
发送邮件
下面代码演示了如何发送带附件的邮件:
const
olByValue = 1;
olByReference = 4;
olEmbeddedItem = 5;
olOLE = 6;
olMailItem = 0;
olAppointmentItem = 1;
olContactItem = 2;
olTaskItem = 3;
olJournalItem = 4;
olNoteItem = 5;
olPostItem = 6;
olFolderDeletedItems = 3;
olFolderOutbox = 4;
olFolderSentMail = 5;
olFolderInbox = 6;
olFolderCalendar = 9;
olFolderContacts = 10;
olFolderJournal = 11;
olFolderNotes = 12;
olFolderTasks = 13;
function SendMailWithAttachments(Email, Subject : string; Body : Widestring ; Filename : string): boolean;
var
outlook : variant;
item : variant;
begin
try
outlook := CreateOLEObject('outlook.application');
try
item := outlook.CreateItem(olMailItem);
item.Subject := Subject;
item.Body := Body;
item.Attachments.Add(FileName,1,1,FileName);
item.To := email;
item.Send;
finally
// 确保Outlook不保持打开状态
outlook.quit;
end;
except
result := false;
exit;
end;
result := true;
end;
函数用法:
SendMailWithAttachments('[email protected]', 'SendMail function', 'Test !', 'd:/test.doc');
注意上面我们使用CreateItem来创建一个mail项目,olMailItem等常数是从office带的帮助中复制过来的。
备份邮件中的附件
下面的函数根据发送者名字或mail地址,备份相应的附件到指定的目录下,并可根据输入参数MailDelete删除相应邮件:
function ManageAttachments(SendersName, AttachmentPath : string; MailDelete : boolean):boolean;
var
oApp : variant;
oNs : variant;
oFolder : variant;
oMsg : variant;
AtC : variant;
AttFilename : variant;
filename : string;
CheckSender : string;
Counter : integer;
MailCounter : integer;
begin
try
oApp := CreateOLEObject('outlook.application');
try
oNs := oApp.GetNamespace('MAPI');
//收件箱
ofolder := oNS.GetDefaultFolder(olFolderInbox);
MailCounter := 1;
// 如果有邮件在收件箱中
if ofolder.items.count > 0 then
begin
repeat
//获得第一封信
oMsg := ofolder.items(MailCounter);
//检查发信人姓名或地址
if CheckSender = SendersName then
begin
// 检查附件数
atc := oMsg.Attachments.count;
if atc > 0 then
begin
// 保存全部附件
for Counter := 1 to atc do
begin
AttFilename := oMsg.Attachments.item(Counter).filename;
filename:= ncludeTrailingBackslash(AttachmentPath) +AttFilename;
oMsg.Attachments.Item(Counter).SaveAsFile(filename);
end;
end;
if MailDelete then
begin
oMsg.delete;
dec(MailCounter);
end;
end;
// 获取下一封信
inc(MailCounter);
until MailCounter > ofolder.items.count;
end;
finally
oApp.quit;
end;
except
result := false;
exit;
end;
result := true;
end;
用法:
ManageAttachments('[email protected]','F:/test',false);
结论
总之清楚地了解Outlook的对象体系后,我们就可以通过自动化轻松地控制Outlook,实现提取各项信息,添加新的用户,发送邮件信息等各项强大的功能。