eMail per Mapi mit mehreren cc, bcc und Anhängen

[ConstantGardener]

Hallo zusammen,

ich habe die altbekannte Funktion hier aus dem Forum zum versenden von eMail über MAPI etwas erweitert um mehrere Anhänge und mehrere Empfänger (sowohl Mail_to, Mail_cc und Mail_bcc)nutzen zu können. Bei meinem System Win7 Premium 64 Bit und Outlock 2010 funktioniert das ganz gut.

Könnte jemand der geneigten Leserschaft (...schleim ) evtl. mal schauen ob diese Methode auch mit anderen Konfigurationen funktioniert und dann hier Rückmeldung geben?
Korrekte Funktion heißt in meinem Fall, dass sich der Default-Mail_Client öffnet und die entsprechenden Daten richtig eingetragen sind. Wäre nett wenn das mal jemand checken würde.

Vielen Dank für Eure Mühe.

entwickelt mit D2010.....

Delphi-Quellcode:

unit MultiSendMail;

interface

uses Windows, Classes, Forms, SysUtils, Mapi ;

type TStrArray = array of String;

function SendEMail(Handle:THandle; Mail:TStrings):Cardinal;

implementation

{  **** Verwendung ***

 procedure TTestForm.Mail1Click(Sender: TObject);
var
  mail: TStringList;
begin
  mail:= TStringList.Create;
  try
      mail.values['to0']:= '[e-mail]';
      mail.values['to1']:= '[e-mail]';
      mail.values['to2']:= '[e-mail]';
      mail.values['to3']:= '[e-mail]';
      mail.values['cc0']:= '[e-mail]';
      mail.values['cc1']:= '[e-mail]';
      mail.values['bcc0']:= '[e-mail]';
      mail.values['subject']:= 'subject';
      mail.values['body']:= 'text text text';
      mail.values['attachment0']:= 'C:\Anhang1.txt';
      mail.values['attachment1']:= 'C:\Anhang2.txt';
      mail.values['attachment2']:= 'C:\Anhang3.txt';
    SendEMail(Self.Handle, mail);
  finally
    mail.Free;
  end;
end;

}

function SendEMail(Handle:THandle; Mail:TStrings):Cardinal;
var
  MapiMessage: TMapiMessage;
  Receip: array of TMapiRecipDesc;
  Attachments: array of TMapiFileDesc;
  i,
  j,
  ReceipCount,
  toCount,
  ccCount,
  bccCount,
  AttachCount: Integer;
  FileName: string;
  MAPI_Session: Cardinal;
  WndList: Pointer;
begin
Result:= MAPI_E_FAILURE;
  if (MapiLogon(Handle, PAnsiChar(''), PAnsiChar(''), MAPI_LOGON_UI or MAPI_NEW_SESSION, 0, @MAPI_Session) <> SUCCESS_SUCCESS)
  then
    MessageBox(Handle, PChar('Fehler beim Versuch eMails zu versenden'), PChar('Error'), MB_ICONERROR or MB_OK)
  else
    begin
      toCount:=0;                                                                // Anzahl der Empfänger
      ccCount:=0;                                                                // Anzahl der Empfänger in cc
      bccCount:=0;                                                               // Anzahl der Empfänger in bcc
      for i:= 0 to MaxInt do                                                     // Empfänger zählen
       begin
        if Mail.Values['to' + IntToStr(i)] = '' then break;
        Inc(toCount);
       end;
      for i:= 0 to MaxInt do                                                     // Empfänger in cc zählen
       begin
        if Mail.Values['cc' + IntToStr(i)] = '' then break;
        Inc(ccCount);
       end;
      for i:= 0 to MaxInt do                                                     // Empfänger in bcc zählen
       begin
        if Mail.Values['bcc' + IntToStr(i)] = '' then break;
        Inc(bccCount);
       end;
      ReceipCount:=toCount+ccCount+bccCount;                                     // Gesamtempfängerzahl errechnen
      SetLength(Receip,ReceipCount);                                             // Empfängerarray dimensionieren
      i:=0;
      if ReceipCount>0 then
       begin
        if toCount>0 then                                                        // Empfängereinträge erzeugen
         for j:=0 to toCount-1 do
          begin
           Receip[i].ulReserved:= 0;
           Receip[i].ulRecipClass:= MAPI_TO;
           Receip[i].lpszName:= StrNew(PAnsiChar(AnsiString(Mail.Values['to'+IntToStr(j)])));
           Receip[i].lpszAddress:= StrNew(PAnsiChar(AnsiString('SMTP:' + Mail.Values['to'+IntToStr(j)])));
           Receip[i].lpEntryID:=nil;
           Receip[i].ulEIDSize:= 0;
           inc(i);
          end;
        if ccCount>0 then                                                        // Empfängereinträge für cc erzeugen
         for j:=0 to ccCount-1 do
          begin
           Receip[i].ulReserved:= 0;
           Receip[i].ulRecipClass:= MAPI_CC;
           Receip[i].lpszName:= StrNew(PAnsiChar(AnsiString(Mail.Values['cc'+IntToStr(j)])));
           Receip[i].lpszAddress:= StrNew(PAnsiChar(AnsiString('SMTP:' + Mail.Values['cc'+IntToStr(j)])));
           Receip[i].lpEntryID:=nil;
           Receip[i].ulEIDSize:= 0;
           inc(i);
          end;
        if bccCount>0 then                                                       // Empfängereinträge für bcc erzeugen
         for j:=0 to bccCount-1 do
          begin
           Receip[i].ulReserved:= 0;
           Receip[i].ulRecipClass:= MAPI_BCC;
           Receip[i].lpszName:= StrNew(PAnsiChar(AnsiString(Mail.Values['bcc'+IntToStr(j)])));
           Receip[i].lpszAddress:= StrNew(PAnsiChar(AnsiString('SMTP:' + Mail.Values['bcc'+IntToStr(j)])));
           Receip[i].lpEntryID:=nil;
           Receip[i].ulEIDSize:= 0;
           inc(i);
          end;
        end;
      MapiMessage.nRecipCount:= ReceipCount;                                     // Empfängeranzahl in Message setzen
      MapiMessage.lpRecips:= Pointer(Receip);                                    // Pointer auf Empfängerarray übergeben

      if Mail.Values['subject']<>'' then MapiMessage.lpszSubject:= PAnsiChar(AnsiString(Mail.Values['subject']));
      if Mail.Values['body']<>'' then MapiMessage.lpszNoteText:= PAnsiChar(AnsiString(Mail.Values['body']));

      AttachCount:= 0;                                                           // Anhänge verarbeiten
      for i:= 0 to MaxInt do                                                     // zählen
       begin
        if Mail.Values['attachment' + IntToStr(i)] = '' then break;
        Inc(AttachCount);
       end;
      SetLength(Attachments, AttachCount);                                       // array dimensinieren

      if AttachCount>0 then
       begin
        for i:=0 to AttachCount-1 do
         begin
          FileName:= Mail.Values['attachment' + IntToStr(i)];                    // Einträge erzeugen
          Attachments[i].ulReserved:= 0;
          Attachments[i].flFlags:= 0;
          Attachments[i].nPosition:= ULONG($FFFFFFFF);
          Attachments[i].lpszPathName:= StrNew(PAnsiChar(AnsiString(FileName)));
          Attachments[i].lpszFileName:= StrNew(PAnsiChar(AnsiString(ExtractFileName(FileName))));
          Attachments[i].lpFileType:= nil;
         end;
        MapiMessage.nFileCount := AttachCount;                                   // Anzahl der Anhänge in der Message setzen
        MapiMessage.lpFiles := Pointer(Attachments);                             // Pointer auf AnhangsArray übergeben
      end;

      WndList:= DisableTaskWindows(0);                                           // "semimodal" machen
      try
        Result:= MapiSendMail(MAPI_Session, Handle, MapiMessage, MAPI_DIALOG, 0);// senden der Mail
      finally
        EnableTaskWindows(WndList);
        for i:=0 to ReceipCount-1 do                                             // aufräumen
         begin
          StrDispose(Receip[i].lpszName);
          StrDispose(Receip[i].lpszAddress);
         end;
        for i:=0 to AttachCount-1 do
         begin
          StrDispose(Attachments[i].lpszPathName);
          StrDispose(Attachments[i].lpszFileName);
         end;
        Finalize(Attachments);                                                   // richtig aufräumen
        Finalize(Receip);
      end;
      MapiLogOff(MAPI_Session, Handle, 0, 0);
    end;
end;

end.

[toms]

Hallo,

funktioniert mit Delphi 6 / Thunderbird 3 / Vista.

Jedoch würde ich das ganze in eine Klasse verpacken, etwa so:

Delphi-Quellcode:

    var
      SendMail: TSendMail;

    with SendMail.Create(nil) do
    begin
      SendTo.Add('[e-mail]');
      SendTo.Add('[e-mail]');
      SendCC.Add('[e-mail]');
      SendBCC.Add('[e-mail]');
      Attachments.Add('C:\Anhang1.txt');
      Attachments.Add('C:\Anhang2.txt');
      Attachments.Add('C:\Anhang3.txt');
      Subject := 'Subject';
      Body := 'text text text';
      Show; // oder Execute oder...
      Free;
    end;

[ConstantGardener]

Hallo Thomas,

danke für den Test. Ja war auch erstmal ein Versuch mit MAPI. Ich war mir nicht sicher ob das mit mehreren cc und bcc so klappt da ich bisher nichts in der Richtung gefunden habe. Na ich schau mal ob ich das noch in ne Klasse gieße. Zwischenzeitlich habe ich den Code etwas aufgehübscht.

Delphi-Quellcode:

unit MultiSendMail;

interface

uses Windows, Classes, Forms, SysUtils, Mapi ;

type TStrArray = array of String;

const MapiRecipClassStrings : array[1..3] of String =('to','cc','bcc');

function SendEMail(Handle:THandle; Mail:TStrings):Cardinal;

implementation

{  **** Verwendung ***

 procedure TTestForm.Mail1Click(Sender: TObject);
var
  mail: TStringList;
begin
  mail:= TStringList.Create;
  try
      mail.values['to0']:= '[e-mail]';
      mail.values['to1']:= '[e-mail]';
      mail.values['to2']:= '[e-mail]';
      mail.values['to3']:= '[e-mail]';
      mail.values['cc0']:= '[e-mail]';
      mail.values['cc1']:= '[e-mail]';
      mail.values['bcc0']:= '[e-mail]';
      mail.values['subject']:= 'subject';
      mail.values['body']:= 'text text text';
      mail.values['attachment0']:= 'C:\Anhang1.txt';
      mail.values['attachment1']:= 'C:\Anhang2.txt';
      mail.values['attachment2']:= 'C:\Anhang3.txt';
    SendEMail(Self.Handle, mail);
  finally
    mail.Free;
  end;
end;

}

function SendEMail(Handle:THandle; Mail:TStrings):Cardinal;
var
  MapiMessage: TMapiMessage;
  Receip: array of TMapiRecipDesc;
  Attachments: array of TMapiFileDesc;
  i,
  j,
  mc,
  ReceipCount,
  AttachCount: Integer;
  FileName: string;
  MAPI_Session: Cardinal;
  WndList: Pointer;
  MapiRecipClassCounter : array[1..3] of Integer;

  function GetMailValue (AMapiRecipClass, Index : Integer) : string;
  begin
   result:=Mail.Values[MapiRecipClassStrings[AMapiRecipClass]+IntToStr(index)];
  end;


begin
Result:= MAPI_E_FAILURE;
  if (MapiLogon(Handle, PAnsiChar(''), PAnsiChar(''), MAPI_LOGON_UI or MAPI_NEW_SESSION, 0, @MAPI_Session) <> SUCCESS_SUCCESS)
  then
    MessageBox(Handle, PChar('Fehler beim Versuch eMails zu versenden'), PChar('Error'), MB_ICONERROR or MB_OK)
  else
    begin
      for MC:=MAPI_TO to MAPI_BCC do
       begin
        MapiRecipClassCounter[MC]:=0;
        for j:= 0 to MaxInt do                                                     // Empfänger zählen
         begin
          if GetMailValue(MC,j) = '' then break;
          Inc(MapiRecipClassCounter[MC]);
         end;
       end;
      ReceipCount:=MapiRecipClassCounter[MAPI_TO]+
                   MapiRecipClassCounter[MAPI_CC]+
                   MapiRecipClassCounter[MAPI_BCC];                              // Gesamtempfängerzahl errechnen
      SetLength(Receip,ReceipCount);                                             // Empfängerarray dimensionieren
      i:=0;
      if ReceipCount>0 then
       begin
        for MC:=MAPI_TO to MAPI_BCC do
         if MapiRecipClassCounter[MC]>0 then
          for j:=0 to MapiRecipClassCounter[MC]-1 do
           begin
            Receip[i].ulReserved:= 0;
            Receip[i].ulRecipClass:= MC;
            Receip[i].lpszName:= StrNew(PAnsiChar(AnsiString(GetMailValue(MC,j))));
            Receip[i].lpszAddress:= StrNew(PAnsiChar(AnsiString('SMTP:' + GetMailValue(MC,j))));
            Receip[i].lpEntryID:=nil;
            Receip[i].ulEIDSize:= 0;
            inc(i);
           end;
        end;
      MapiMessage.nRecipCount:= ReceipCount;                                     // Empfängeranzahl in Message setzen
      MapiMessage.lpRecips:= Pointer(Receip);                                    // Pointer auf Empfängerarray übergeben

      if Mail.Values['subject']<>'' then MapiMessage.lpszSubject:= PAnsiChar(AnsiString(Mail.Values['subject']));
      if Mail.Values['body']<>'' then MapiMessage.lpszNoteText:= PAnsiChar(AnsiString(Mail.Values['body']));

      AttachCount:= 0;                                                           // Anhänge verarbeiten
      for i:= 0 to MaxInt do                                                     // zählen
       begin
        if Mail.Values['attachment' + IntToStr(i)] = '' then break;
        Inc(AttachCount);
       end;
      SetLength(Attachments, AttachCount);                                       // array dimensinieren

      if AttachCount>0 then
       begin
        for i:=0 to AttachCount-1 do
         begin
          FileName:= Mail.Values['attachment' + IntToStr(i)];                    // Einträge erzeugen
          Attachments[i].ulReserved:= 0;
          Attachments[i].flFlags:= 0;
          Attachments[i].nPosition:= ULONG($FFFFFFFF);
          Attachments[i].lpszPathName:= StrNew(PAnsiChar(AnsiString(FileName)));
          Attachments[i].lpszFileName:= StrNew(PAnsiChar(AnsiString(ExtractFileName(FileName))));
          Attachments[i].lpFileType:= nil;
         end;
        MapiMessage.nFileCount := AttachCount;                                   // Anzahl der Anhänge in der Message setzen
        MapiMessage.lpFiles := Pointer(Attachments);                             // Pointer auf AnhangsArray übergeben
      end;

      WndList:= DisableTaskWindows(0);                                           // "semimodal" machen
      try
        Result:= MapiSendMail(MAPI_Session, Handle, MapiMessage, MAPI_DIALOG, 0);// senden der Mail
      finally
        EnableTaskWindows(WndList);
        for i:=0 to ReceipCount-1 do                                             // aufräumen
         begin
          StrDispose(Receip[i].lpszName);
          StrDispose(Receip[i].lpszAddress);
         end;
        for i:=0 to AttachCount-1 do
         begin
          StrDispose(Attachments[i].lpszPathName);
          StrDispose(Attachments[i].lpszFileName);
         end;
        Finalize(Attachments);                                                   // richtig aufräumen
        Finalize(Receip);
      end;
      MapiLogOff(MAPI_Session, Handle, 0, 0);
    end;
end;

end.

[DevidEspenschied]

Funktioniert leider nicht mit Windows 7 und Office 2010.

Der Aufruf von SendEMail lässt den Bildschirm kurz flackern, danach scheint die Applikation für ca. 15 Sekunden einzufrieren. Danach wird die Steuerung an die Applikation zurück übertragen, Outlook hat aber keine neu erstellte Email im Postausgang.

[ensaron]

Hi und danke für diese praktische Funktion, hat mir grad den Nachmittag gerettet ^^

Funktioniert (in der aufgefrischten Version) mit Windows XP Prof. und Outlook 2003

[ConstantGardener]

Danke für die Rückmeldung. Funktioniert bei Mir auch unter win7 und office 2010.

[mjustin]

MapiSendMail funktioniert auch, wenn ein 32 Bit Client auf die 64 Bit Version von Office / Outlook zugreift (http://msdn.microsoft.com/en-us/library/dd941355.aspx) - daher ist hilfreich zu wissen, welche Bittigkeit getestet wurde ...

[ConstantGardener]

Ja wie schon oben geschrieben win7 64Bit mit Office 2010 (32 Bit ?).

[mjustin]

Zitat von ConstantGardener:

Ja wie schon oben geschrieben win7 64Bit mit Office 2010 (32 Bit ?).

Auf 64 Bit Windows kann ein 32 oder ein 64 Bit Outlook/Office installiert sein. Wie gesagt, klappt MAPI bei 64 Bit Outlook nur eingeschränkt auf die MaipSendMail Funktion. Unterschiedliche Testresultate einer Delphi-Anwendungen können daher von der Outlook/Office Version abhängen, wenn darüber hinaus andere MAPI Funktionen verwendet werden...

[ConstantGardener]

Hallo MJustin,

ja ich habe nochmal gegengecheckt. Ich habe hier Win 7 64 Bit und ein Outlook 2010 32 Bit. In dieser Konstellation funktioniert der Code ohne Probleme. Ist aber wie immer mit solchen nicht voll implementierten "Standard"-Schnittstellen, nicht wirklich schön. Wenn man den Standard-Mail-Client mit Anhängen usw. nutzen will hat man aber sonst keine allgemein gültige Alternative. Oder habe ich etwas übersehen? SMTP finde ich zwar ok aber meinen Kunden traue ich die Einstellungen nicht wirklich zu.

cu cg