将邮件从OutLook拉到文件

Question

从我的Delphi程序中,我希望能够从OutLook中的某个文件夹中检索所有邮件,并将它们保存为文件.我需要检索发件人,主题,日期和消息iD,以便将信息保存在表格中(如果可能的话,更多部分)我希望将每封邮件保存在一个文件中,以便我以后可以访问它们.

Answer 1

这是完全可能的.您需要的是Outlook自动化.无论是简单的香草,还是使用Delphi附带的COM Server包装的那种.如果您对德尔福的新版本中的一个,你可能需要安装相应的包找到他们在你的调色板.请参阅如何在XE2中获取TExcelWorksheet(64位版本)？欲获得更多信息.

有关如何自动化Outlook的更多信息,请直接转到源:有关Outlook COM对象模型和API的文档的MSDN:http://msdn.microsoft.com/en-us/library/ms268893(v = vs 0.80)的.aspx

另一个来源是Deborah Pate的COM编程网站.它可能在很长一段时间内没有更新,但那里的信息仍然很好且相关:http://www.djpate.freeserve.co.uk/Automation.htm

示例代码

Unit包含两个类来读取特定文件夹中的邮件.它使用Outlook COM服务器包装器形式Delphi(一个非常旧的版本),但您不需要在调色板上将它们放在代码中进行实例化.当然,您需要在搜索路径上安装COM包装器单元.

像这样实例化TSiteMailList类:

FMailList := TSiteMailList.Create('MAPI', 'Folder1', 'Folder2');

MAPI是Outlook MAPI NameSpace.Folder1和Folder2是outlook邮件文件夹的名称.此处可以使用"收件箱"作为默认邮件收件箱.

TSiteMailList类声明:

  TSiteMailList = class(TObject)
  private
    FShowUnreadOnly: boolean;
    FMails: TObjectList;

    FOutlook: TOutlookApplication;
    FNameSpace: NameSpace;
    FNewMailsFolder: MAPIFolder;
    FProcessedMailsFolder: MAPIFolder;
    function FindFolder(FolderPath: string): MAPIFolder;
    procedure LoadMails;
    function GetSiteMail(idx: integer): TSiteMail;
    function GetShowUnreadOnly: boolean;
    procedure SetShowUnreadOnly(const Value: boolean);
  protected
    function GetCount: integer;
  public
    constructor Create(MAPINameSpace: string; NewMailsFolder, ProcessedMailsFolder:
        string);
    destructor Destroy; override;
    procedure MarkAsProcessed(SiteMail: TSiteMail);
    procedure Reload;
    property ShowUnreadOnly: boolean read GetShowUnreadOnly write SetShowUnreadOnly;
    property Count: integer read GetCount;
    property SiteMail[idx: integer]: TSiteMail read GetSiteMail;
  end;

它的构造函数和析构函数:

constructor TSiteMailList.Create(MAPINameSpace: string; NewMailsFolder,
    ProcessedMailsFolder: string);
begin
  FOutlook := TOutlookApplication.Create( nil );
  FOutlook.ConnectKind := ckNewInstance;
  FOutlook.Connect;
  FNameSpace := FOutlook.GetNameSpace( MAPINameSpace );
  FNameSpace.Logon( '', '', False, False );
  FNewMailsFolder := FindFolder( NewMailsFolder );
  FProcessedMailsFolder := FindFolder( ProcessedMailsFolder );

  FShowUnreadOnly := false;
  FMails := TObjectList.Create( true );
  LoadMails;
end;

destructor TSiteMailList.Destroy;
begin
  FMails.Free;
  if FNameSpace <> nil then begin
    FNameSpace.Logoff;
  end;
  FOutlook.Disconnect;
  FOutlook.Free;

  inherited;
end;

Outlook文件夹可以嵌套.传递给构造函数的文件夹名称可以使用'\'来分隔文件夹名称.下面的代码解析路径并找到相应的Outlook文件夹:

procedure ExtractFolderFromPath(var path, folder: string);
var
  i: integer;
begin
  folder := '';
  if path[1] = '\' then begin
    path := Copy( path, 2, Length( path ) - 1 );
  end;
  i := Pos( '\', path );
  if i > 0 then begin
    folder := Copy( path, 1, i - 1 );
    path := Copy( path, i + 1, Length( path ) - i );
  end else begin
    folder := path;
    path := '';
  end;
end;

function TSiteMailList.FindFolder(FolderPath: string): MAPIFolder;
var
  path: string;
  foldername: string;
  xFolder: MAPIFolder;
begin
  path := FolderPath;
  ExtractFolderFromPath( path, foldername );
  if foldername <> '' then begin
    xFolder := FNameSpace.Folders.Item( foldername );
  end;
  while path <> '' do begin
    ExtractFolderFromPath( path, foldername );
    xFolder := xFolder.Folders.Item( foldername );
  end;
  Result := xFolder;
end;

吸气剂和制定者非常直接,所以我把它们排除在外.LoadMails方法是访问文件夹中每个邮件项所需的方法:

procedure TSiteMailList.LoadMails;
var
  i: integer;
  GeneralItem: IDispatch;
  MI: MailItem;
begin
  FMails.Clear;
  for i := 1 to FNewMailsFolder.Items.Count do begin
    GeneralItem := FNewMailsFolder.Items.Item( i );
    if Sysutils.Supports(GeneralItem, MailItem, MI) then begin
      if not FShowUnreadOnly
      or ( FShowUnreadOnly and ( MI.Unread = true ) )
      then begin
        FMails.Add( TSiteMail.Create( i, MI ) );
      end;
    end;
  end;
end;

TSiteMailList使用TSiteMail类来跟踪其构造函数的第一个文件夹参数指定的文件夹中有关Outlook邮件项的信息.TSiteMail类声明:

  TSiteMail = class(TObject)
  private
    FOutlookIdx: integer;
    FMailItem: MailItem;
    function GetIsRead: boolean;
    procedure SetIsRead(const Value: boolean);
  protected
    function GetBody: string;
    function GetFileCount: integer;
    function GetFileName(idx: integer): string;
    function GetReceived: TDateTime;
    function GetSender: string;
    function GetSubject: string;
  public
    constructor Create(idx: integer; MI: MailItem);
    destructor Destroy; override;
    function IndexOfFileName(Name: string): integer;
    procedure MoveToFolder(Folder: MAPIFolder);
    procedure SaveFile(idx: integer; FileName: string);

    property Body: string read GetBody;
    property FileCount: integer read GetFileCount;
    property FileName[idx: integer]: string read GetFileName;
    property IsRead: boolean read GetIsRead write SetIsRead;
    property Received: TDateTime read GetReceived;
    property Sender: string read GetSender;
    property Subject: string read GetSubject;
  end;

它的实施:

constructor TSiteMail.Create(idx: integer; MI: MailItem);
begin
  FOutlookIdx := idx;
  FMailItem := MI;
end;

destructor TSiteMail.Destroy;
begin
  FMailItem := nil; // Release interface
  inherited;
end;

function TSiteMail.GetBody: string;
begin
  Result := FMailItem.Body;
end;

function TSiteMail.GetFileCount: integer;
begin
  Result := FMailItem.Attachments.Count;
end;

function TSiteMail.GetFileName(idx: integer): string;
begin
  Result := FMailItem.Attachments.Item( idx + 1 ).FileName;
end;

function TSiteMail.GetIsRead: boolean;
begin
  Result := not FMailItem.UnRead;
end;

function TSiteMail.GetReceived: TDateTime;
begin
  Result := FMailItem.ReceivedTime;
end;

function TSiteMail.GetSender: string;
begin
  Result := FMailItem.SenderName;
end;

function TSiteMail.GetSubject: string;
begin
  Result := FMailItem.Subject;
end;

function TSiteMail.IndexOfFileName(Name: string): integer;
var
  idx: integer;
begin
  Result := -1;
  for idx := 1 to FMailItem.Attachments.Count do begin
    if CompareText( Name, FMailItem.Attachments.Item( idx ).FileName ) = 0 then begin
      Result := idx - 1;
      break;
    end;
  end;
end;

procedure TSiteMail.MoveToFolder(Folder: MAPIFolder);
begin
  FMailItem.Move( Folder );
end;

procedure TSiteMail.SaveFile(idx: integer; FileName: string);
begin
  FMailItem.Attachments.Item( idx + 1 ).SaveAsFile( FileName );
end;

procedure TSiteMail.SetIsRead(const Value: boolean);
begin
  FMailItem.UnRead := not Value;
end;