über Outlook E-Mail senden

[toms]

Hallo

Moechte eine E-Mail ueber Outlook (2002, XP) senden.
Alles funktioniert ausser dass der Absender leer bleibt, obwowhl
dem MAPIMessage.lpOriginator der Absender zugewiesen wird.
Hat jemand was am Code nicht stimmt (oder liegt's am Outlook)?

Delphi-Quellcode:

uses 
  MAPI;

Delphi-Quellcode:

function SendEMail(Handle: THandle; Mail: TStrings): Cardinal;
type
  TAttachAccessArray = array[0..0] of TMapiFileDesc;
  PAttachAccessArray = ^TAttachAccessArray;
var
  MapiMessage: TMapiMessage;
  Receip: TMapiRecipDesc;
  Origin: TMapiRecipDesc;
  Attachments: PAttachAccessArray;
  AttachCount: Integer;
  i1: integer;
  FileName: string;
  dwRet: Cardinal;
  MAPI_Session: Cardinal;
  WndList: Pointer;
begin
 // begin a Simple MAPI session
  dwRet := MapiLogon(Handle,
    PChar(''),
    PChar(''),
    MAPI_LOGON_UI or MAPI_NEW_SESSION,
    0, @MAPI_Session);

  if (dwRet <> SUCCESS_SUCCESS) then
  begin
    MessageBox(Handle,
      PChar('Error while trying to send email'),
      PChar('Error'),
      MB_ICONERROR or MB_OK);
  end
  else
  begin
    FillChar(MapiMessage, SizeOf(MapiMessage), #0);
    Attachments := nil;

    // Fill Receip property
    FillChar(Receip, SizeOf(Receip), #0);
    if Mail.Values['to'] <> '' then
    begin
      Receip.ulReserved := 0;
      Receip.ulRecipClass := MAPI_TO;
      Receip.lpszName := StrNew(PChar(Mail.Values['to']));
      Receip.lpszAddress := StrNew(PChar('SMTP:' + Mail.Values['to']));
      Receip.ulEIDSize := 0;
      MapiMessage.nRecipCount := 1;
      MapiMessage.lpRecips := @Receip;
    end;

    // Fill Origin(ator) property
    FillChar(Origin, SizeOf(Origin), #0);
    if Mail.Values['from'] <> '' then
    begin
      Origin.ulReserved := 0;
      Origin.ulRecipClass := MAPI_ORIG;
      Origin.lpszName := StrNew(PChar(Mail.Values['from']));
      Origin.lpszAddress := StrNew(PChar('SMTP:' + Mail.Values['from']));
      Origin.ulEIDSize := 0;
      Origin.lpEntryID := nil;
      MAPIMessage.lpOriginator := @Origin;
    end;

    AttachCount := 0;

    for i1 := 0 to MaxInt do
    begin
      if Mail.Values['attachment' + IntToStr(i1)] = '' then
        break;
      Inc(AttachCount);
    end;

    if AttachCount > 0 then
    begin
      GetMem(Attachments, SizeOf(TMapiFileDesc) * AttachCount);

      for i1 := 0 to AttachCount - 1 do
      begin
        FileName := Mail.Values['attachment' + IntToStr(i1)];
        Attachments[i1].ulReserved := 0;
        Attachments[i1].flFlags := 0;
        Attachments[i1].nPosition := ULONG($FFFFFFFF);
        Attachments[i1].lpszPathName := StrNew(PChar(FileName));
        Attachments[i1].lpszFileName :=
          StrNew(PChar(ExtractFileName(FileName)));
        Attachments[i1].lpFileType := nil;
      end;
      MapiMessage.nFileCount := AttachCount;
      MapiMessage.lpFiles := @Attachments^;
    end;

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

    WndList := DisableTaskWindows(0);
    try
      Result := MapiSendMail(MAPI_Session, Handle,
        MapiMessage, MAPI_DIALOG, 0);
    finally
      EnableTaskWindows(WndList);
    end;

    for i1 := 0 to AttachCount - 1 do
    begin
      StrDispose(Attachments[i1].lpszPathName);
      StrDispose(Attachments[i1].lpszFileName);
    end;

    if Assigned(MapiMessage.lpszSubject) then
      StrDispose(MapiMessage.lpszSubject);
    if Assigned(MapiMessage.lpszNoteText) then
      StrDispose(MapiMessage.lpszNoteText);
    if Assigned(Receip.lpszAddress) then
      StrDispose(Receip.lpszAddress);
    if Assigned(Receip.lpszName) then
      StrDispose(Receip.lpszName);
    if Assigned(Origin.lpszAddress) then
      StrDispose(Origin.lpszAddress);
    if Assigned(Origin.lpszName) then
      StrDispose(Origin.lpszName);
    MapiLogOff(MAPI_Session, Handle, 0, 0);
  end;
end;

Delphi-Quellcode:

procedure TfrmMain.btnSendClick(Sender: TObject);
var
  mail: TStringList;
  ssubject: string;
begin
  mail := TStringList.Create;
  try
    mail.values['from'] := '[e-mail]';
    mail.values['to'] := '[e-mail]';
    mail.values['subject'] := 'subject';
    mail.values['body'] := 'body';
    try
      sendEMail(Application.Handle, mail);
    except
    end;
  finally
    mail.Free;
  end;
end;

[toms]

*PUSH*

[toms]

*PUSH*

[Sharky]

Hai Toms,

in meinem Sedeformular von Outlook bleibt das Feld "Von:" auch lehr. Aber wenn ich die Mail absende steht als Absender immer der Standardabsender von Outlook. Eventuell kann man das überhaupt nicht umstellen?

[toms]

Manuell kann ich schon den Absender eingeben, wenn ich mehrere E-Mail Konten eingerichtet habe. Nur per Code nicht...

[toms]

*PUSH* ?

[Sharky]

Hai toms,

ein Lösung habe ich leider auch nocht nicht. Interessant ist aber das auch die Felder für BCC/CC Leerbleiben wenn ich in deinem Code die entsprechende ergänzung dafür einfüge.

Ich werde auch weiter suchen.

[Luckie]

In der Code-Lib gibt es ein Beispiel zu MAPI.

[Sharky]

Zitat:

Zitat von Luckie

In der Code-Lib gibt es ein Beispiel zu MAPI.

Hai Luckie,

mit dem Code von toms kann man ja eine Mail versenden. Das Problem ist das der Sender nicht berücksichtigt wird (Origin.ulRecipClass := MAPI_ORIG;)

[Luckie]

Nun, ich dachte man könnte die Codes mal vergelichen bzw. den aus der Code-Lib mal ausprobieren, ob damit alles funktioniert und dann mal gucken worin sie sich unterscheiden.