Вытягивание почты из OutLook в файлы - PullRequest
Новая
       24

Вытягивание почты из OutLook в файлы

1 голос
/ 17 марта 2012

Из моей программы Delphi я хотел бы иметь возможность получать все письма из определенной папки в моем OutLook и сохранять их в виде файлов. Мне нужно будет получить идентификатор отправителя, темы, даты и сообщения, чтобы сохранить информацию в таблице (если возможно, больше деталей) Я ожидаю сохранить каждое письмо в файле, чтобы получить к нему доступ позже.

1 Ответ

5 голосов
/ 17 марта 2012

Это вполне возможно. Что вам нужно, это автоматизация Outlook. Либо простой ванильный, либо тот, который использует обертки COM-сервера, которые поставляются с Delphi. Если вы используете одну из более новых версий Delphi, вам может потребоваться установить соответствующий пакет, чтобы найти их в палитре. См. Как получить TExcelWorksheet (64-разрядная версия) в XE2? для получения дополнительной информации.

Для получения дополнительной информации о том, как можно автоматизировать Outlook, перейдите непосредственно к источнику: MSDN для документации по объектной модели и API COM COM: http://msdn.microsoft.com/en-us/library/ms268893(v=vs.80).aspx

Другим источником является сайт Деборы Пейт о программировании COM. Возможно, он не обновлялся долгое время, но информация там все еще хороша и актуальна: http://www.djpate.freeserve.co.uk/Automation.htm

Пример кода

Блок содержит два класса для чтения писем в определенной папке. Он использует оболочку Outlook COM-сервера формы Delphi (очень старая версия), но вам не нужно иметь их на палитре, так как они создаются в коде. Разумеется, вам нужно иметь в своем поисковом модуле обертки COM.

Создание экземпляра класса TSiteMailList следующим образом: 

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

MAPI - это пространство имен Outlook MAPI. 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;
...