利用自动化控制Outlook

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('Info@outlook.com', '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('info@outlook.com','F:\test',false);

结论

　　总之清楚地了解Outlook的对象体系后，我们就可以通过自动化轻松地控制Outlook，实现提取各项信息，添加新的用户，发送邮件信息等各项强大的功能。