Einzelnen Beitrag anzeigen

medirar

Registriert seit: 4. Feb 2009
Ort: BO
24 Beiträge
 
RAD-Studio 2009 Arc
 
#5

AW: sOutlook 2010 - Mail Betreff auslesen und Anhang speichern

  Alt 3. Jan 2012, 21:55
Hallo! Das werk ist nun vollbracht! Zur Hilfe kam mir dieser Code.

Kann man mit MAPI auch auf "Benutzerdefinierte Ordner" zugreifen?

http://www.swissdelphicenter.ch/de/showcode.php?id=383

Delphi-Quellcode:
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;
  Mit Zitat antworten Zitat