Outllook 365 MAPI HTML

[haentschman]

Moin...

Meine Lösung heißt: TOutlookApplication

In der Konfiguration kann man nun wählen welcher Client am Start ist.

Auszüge:

Delphi-Quellcode:

function TToolsMail.SendMailClient: Boolean;
var
  FunctionResult: Boolean;

  function SendMAPI: Boolean;

  {$REGION 'Inline'}
    procedure FillMailRecipents;
    var
      I: Integer;
      RecipientItem: TCollectionItem;
    begin
    {$REGION 'Code'}
      FMailStandardClient.Recipients.Clear;
      for I := 0 to FMailMessage.ToList.Count - 1 do
      begin
        RecipientItem := FMailStandardClient.Recipients.Add;
        TRecipientItem(RecipientItem).Address := FMailMessage.ToList.Items[I].Email;
      end;
    {$ENDREGION}
    end;

    procedure FillMailAttachments;
    var
      I: Integer;
    begin
    {$REGION 'Code'}
      FMailStandardClient.Attachments.Clear;
      for I := 0 to FAttachments.Count - 1 do
      begin
        FMailStandardClient.Attachments.Add(FAttachments[I]);
      end;
    {$ENDREGION}
    end;

    procedure FillMailBody;
    begin
    {$REGION 'Code'}
      FMailStandardClient.Subject := FMailMessage.Subject;
      FMailStandardClient.Text := FMailMessage.Html.Strings;
    {$ENDREGION}
    end;
  {$ENDREGION}

  begin
    FillMailBody;
    FillMailRecipents;
    FillMailAttachments;

    Result := FMailStandardClient.Execute;
  end;

  function SendOutlook: Boolean;
  var
    Outlook: TOutlookApplication;
    Mail: OleVariant;

  {$REGION 'Inline'}
    procedure FillMailRecipents;
    var
      List: TStringList;
    begin
    {$REGION 'Code'}
      List := TStringList.Create;
      try
        List.Delimiter := ';';
        FMailMessage.ToList.GetEmailList(List);
        Mail.To :=  List.DelimitedText;
      finally
        List.Free;
      end;
    {$ENDREGION}
    end;

    procedure FillMailAttachments;
    var
      I: Integer;
    begin
    {$REGION 'Code'}
      for I := 0 to FAttachments.Count - 1 do
      begin
        Mail.Attachments.Add(FAttachments[I]);
      end;
    {$ENDREGION}
    end;

    procedure FillMailBody;
    begin
    {$REGION 'Code'}
      Mail.BodyFormat := olFormatHTML;
      Mail.Subject := FMailMessage.Subject;
      Mail.GetInspector;
      Mail.HTMLBody := OleVariant(FMailMessage.Html.Strings.Text) + Mail.HTMLBody;
    {$ENDREGION}
    end;
  {$ENDREGION}

  begin
    Result := True;
    Outlook:= TOutlookApplication.Create(nil);
    try
      Mail := Outlook.CreateItem(olMailItem);

      FillMailBody;
      FillMailRecipents;
      FillMailAttachments;

      try
        Mail.Display;
      except
        Result := False;
      end;
    finally
      Outlook.Free;
    end;
  end;

begin
  Result := True;
  try
    FunctionResult := False;

    FMail.Open;
    try
      CreateMailMessage;

      case FPreferences.PreferencesMail.ClientType of
        cltMAPI:
        begin
          FunctionResult := SendMAPI;
        end;
        cltOutlook:
        begin
          FunctionResult := SendOutlook;
        end;
      end;

      if FunctionResult then
      begin
        WriteMailDB;
        if Assigned(FOnMailSend) then
        begin
          FOnMailSend(Self, FMailMessage.ToList.EmailAddresses, FMailMessage.Subject);
        end;
      end;
    finally
      FMail.Close;
    end;
  except
    on E: System.SysUtils.Exception do
    begin
      if Assigned(FOnMailError) then
      begin
        FOnMailError(Self, FReceipients, FMailMessage.Subject, E.Message);
      end;
      Result := False;
    end;
  end;
end;