Сохранить вложения OutLook

{
Won’t some backups of your outlook attachments are filtered
some incoming log files? Here's the function.
}

uses
  ComObj;

{...}

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(6); // FolderTypeEnum (olFolderInbox)
      MailCounter := 1;
      // if there is any email in the inbox
      if oFolder.Items.Count > 0 then
      begin
        repeat
          // get the first email
          oMsg := oFolder.Items(MailCounter);
          // check the name or email
          // use CheckSender := oMsg.Subject to search on subject;
          CheckSender := oMsg.SenderName;
          if CheckSender = SendersName then // remove this line to backup all your attachments.
          begin
            // check how many attachments
            atc := oMsg.Attachments.Count;
            if atc > 0 then
            begin
              // get all the attachments and save them
              for Counter := 1 to atc do
              begin
                attFilename := oMsg.Attachments.Item(Counter).Filename;
                //Filename := IncludeTrailingBackslash(AttachmentPath)+attFilename; {use this line for d5)}
                Filename := AttachmentPath + '' + attFilename;
                oMsg.Attachments.Item(Counter).SaveAsFile(Filename);
              end;
            end;
            if MailDelete then
            begin
              oMsg.Delete;
              // there's 1 email less, so MailCounter - 1
              Dec(MailCounter);
            end;
          end;

          // get the next email
          Inc(MailCounter);
          // do until there is no more email to check
        until MailCounter > oFolder.Items.Count;
      end;
    finally
      oApp.Quit;
    end;
  except
    Result := False;
    exit;
  end;
  Result := True;
end;


procedure TForm1.Button1Click(Sender: TObject);
begin
  // manageattachments(email or name, backup directory, MailDelete yes or no)
  ManageAttachments('info@cleys.com', 'f:test', False);
end;


{
Warning!
All your selected email will be deleted if MailDelete = True

Achtung!
Alle e-mails werden geloscht, wenn MailDelete = True ist.
}

Autor: patrick cleys
Source: http://www.dcmedical.org
Source: http://www.swissdelphicenter.ch/
ID: 04456