使用Delphi从Outlook收件箱收集电子邮件

问题描述

我写了一些代码来从Outlook收件箱中读取电子邮件并收集附件。

这很好。我正在使用Outlook 2019 / Office 365。

我可以同时使用Mail.SenderEmailAddress或Mail.Sender.Address来获取发件人的电子邮件地址。

使用Outlook 2016将应用程序部署到另一台计算机时，出现此错误：

EOleError：自动化对象不支持方法'Sender'

与Mail.SenderEmailAddress相同

Outlook 2016或2019具有相同的代码流。参见Outlook versions,build numbers and other trivia。

您能帮助我理解为什么我的客户计算机上出现此类错误以及如何解决该问题吗？

您是否知道免费/商业库或组件可以顺利完成此任务？

这与我关于Sending Outlook Email with Delphi的其他问题有联系。

try
  Outlook:=GetActiveOleObject('outlook.application') ;
except
  Outlook:=CreateOleObject('outlook.application') ;
end;

try
  oNameSpace := Outlook.GetNamespace('MAPI');
  oNameSpace.logon;

  InBox:= oNameSpace.GetDefaultFolder(6);
  iNbMail:= InBox.Items.Count;

  for i:= iNbMail downto 1 do
  begin
    if VarIsNull(InBox.Items[i]) or VarIsEmpty(InBox.Items[i])  then
      Continue;

    Mail:= InBox.Items[i];
    EmailAddress:= Mail.Sender.Address;
    // EmailAddress:= Mail.SenderEmailAddress;
          
    UnReadFlag:= Mail.UnRead;
    iNbAttach := Mail.Attachments.Count;

    for j := iNbAttach downto 1 do
    begin
      Attachment:= Mail.Attachments[j];
      if ExtractFileExt(Attachment.FileName) = '.pdf' then
      begin
        SaveName:= TPath.Combine(InBoxFolder,Attachment.FileName);
        Attachment.SaveAsFile(SaveName);
      end;
    end;
    Mail.UnRead:= False;
  end;
finally
  Outlook:= Unassigned;
  oNameSpace:= Unassigned;
  InBox:= Unassigned;
  Mail:= Unassigned;
end;

解决方法

Outlook中的收件箱文件夹不限于仅包含邮件。遍历其项目时，您会遇到各种项目类别，例如MailItem，PostItem，MeetingItem，TaskRequestItem等。所有这些项目都支持不同的属性集，但并非全部都具有Sender，SenderEmailAddress或Attachments属性。如果您只对邮件感兴趣，则需要检查邮件的Class属性：

const
  olMail = $0000002B;

{ ... }

for i := iNbMail downto 1 do
begin
  Mail := Inbox.Items[i];
  if Mail.Class <> olMail then
    Continue;

  { here we can assume we're working with MailItem instance }
  
end;

我怀疑Outlook是否会返回null或空项目，因此您在代码中执行的检查毫无意义。如果您对其他商品类别感兴趣，请查看OlObjectClass枚举。

我不确定您为什么喜欢使用late-binding，因为Delphi已经提供了导入类型库Outlook2010.pas来以强类型方式自动化Outlook。该库位于安装文件夹的OCX\Servers子文件夹中。如果您需要支持2010之前的Outlook版本，则可以使用单位OutlookXP或什至Outlook2000。使用类型库对邮件项进行迭代的代码如下所示：

uses
  System.SysUtils,System.Variants,Winapi.ActiveX,Outlook2010;

function GetOutlookApplication: OutlookApplication;
var
  ActiveObject: IUnknown;
begin
  if Succeeded(GetActiveObject(OutlookApplication,nil,ActiveObject)) then
    Result := ActiveObject as OutlookApplication
  else
    Result := CoOutlookApplication.Create;
end;

procedure ProcessInboxItems;
var
  Outlook: OutlookApplication;
  Inbox: Folder;
  Index: Integer;
  LItems: Items;
  LMailItem: MailItem;
begin
  Outlook := GetOutlookApplication;
  Outlook.Session.Logon(EmptyParam,EmptyParam,EmptyParam);

  Inbox := Outlook.Session.GetDefaultFolder(olFolderInbox);
  LItems := Inbox.Items;
  for Index := LItems.Count downto 1 do
  begin
    if Supports(LItems.Item(Index),MailItem,LMailItem) then
    begin
      { do whatever you wish with LMailItem }
    end;
  end;
end;