Question

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

Answer 1

这完全有可能。您需要的是Outlook自动化。无论是简单的香草，还是使用Delphi附带的COM Server包装的那种。如果您使用的是较新版本的Delphi，则可能必须安装相应的软件包才能在调色板上找到它们。有关详细信息，请参阅How to get TExcelWorksheet (the 64-bit version) in XE2?。

有关如何自动执行Outlook的详细信息，请直接转到源：有关Outlook COM对象模型和API的文档的MSDN：http://msdn.microsoft.com/en-us/library/ms268893(v=vs.80).aspx

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

示例代码

单元包含两个类来读取特定文件夹中的邮件。它使用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;

将邮件从OutLook拉到文件

1 个答案:

示例代码