Delphi知识中心
www.delphi.ee
提供Delphi技术知识
与Delphi程序员共同进步


在线服务QQ:99923144 随时恭候您的光临
首页 基础知识 WIN系统 组件使用 组件开发 数据库 ACTIVEX 多媒体技术 网络技术 关于
文章类别:ACTIVEX    你尚未登陆,会员功能无法使用,请从 网站首页 登陆。
  利用自动化控制Outlook  
 
利用自动化控制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,实现提取各项信息,添加新的用户,发送邮件信息等各项强大的功能。

 

在线服务QQ:99923144 Delphi程序员QQ群(139442)
Delphi知识中心 www.delphi.ee 最专业的Delphi技术资料网站