Объектная модель Outlook - обнаружение, было ли отправлено письмо

Question

У меня есть следующий код в моем тестовом приложении BDS Delphi 2006:

procedure TForm1.Button1Click(Sender: TObject);
const
  olMailItem = 0;
var
  Outlook: OleVariant;
  vMailItem: variant;
begin
  Outlook := CreateOleObject('Outlook.Application');
  vMailItem := Outlook.CreateItem(olMailItem);

  try
    vMailItem.Recipients.add('anemailaddress@gmail.com');
    vMailItem.Display(True); -- outlook mail message is displayed modally
  except
  end;

  VarClear(Outlook);
end;

Я должен быть в состоянии определить, отправил ли пользователь электронное письмо с экрана Outlook.Я попробовал следующий код:

if vMailItem.Sent then
 ...

Но получил сообщение об ошибке «Элемент был перемещен или удален».Я предполагаю, что это потому, что почтовый элемент перемещен в папку отправленных элементов.Как лучше всего определить, отправил ли пользователь электронное письмо?Кроме того, если пользователь отправил электронное письмо, мне также понадобилось бы просмотреть его тело.

Заранее спасибо.

Answer 1

Казалось бы, вы должны использовать Send Event почтового отправления. Это было бы намного проще, если бы вы использовали раннее связывание, поместите один из файлов 'outlook [*]. Pas' в папку '.. \ OCX \ Servers' RAD studio в предложении 'users', затем:

uses
  ..., outlook2000;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    OutlookApplication: TOutlookApplication;
    procedure OnMailSend(Sender: TObject; var Cancel: WordBool);
  public
  end;

[...]

procedure TForm1.FormCreate(Sender: TObject);
begin
  OutlookApplication := TOutlookApplication.Create(Self);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  MailItem: _MailItem;
  Mail: TMailItem;
begin
  MailItem := OutlookApplication.CreateItem(olMailItem) as _MailItem;

  Mail := TMailItem.Create(nil);
  try
    Mail.ConnectTo(MailItem);
    Mail.OnSend := OnMailSend;

    MailItem.Recipients.Add('username@example.com');
    MailItem.Display(True);
  finally
    Mail.Free;
  end;
end;

procedure TForm1.OnMailSend(Sender: TObject; var Cancel: WordBool);
begin
  ShowMessage((Sender as TMailItem).Body);
end;
 

При позднем связывании вам придется выполнять часть работы, которую выполняет импортированная оболочка. Простейшим примером может быть что-то вроде этого:

 
type
  TForm1 = class(TForm, IDispatch)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    FCookie: Integer;
    FMailItem: OleVariant;
    procedure MailSent;
  protected
    function QueryInterface(const IID: TGUID; out Obj): HResult; override;
    function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
      Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult;
      stdcall;
  public
  end;

[...]

uses
  comobj;

const
  DIID_ItemEvents: TGUID = '{0006303A-0000-0000-C000-000000000046}';
  SendItemDispID = 61445;

function TForm1.QueryInterface(const IID: TGUID; out Obj): HResult;
begin
  if IsEqualIID(IID, DIID_ItemEvents) and GetInterface(IDispatch, Obj) then
    Result := S_OK
  else
    Result := inherited QueryInterface(IID, Obj);
end;

function TForm1.Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
  Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult;
begin
  Result := S_OK;
  if DispID = SendItemDispID then
    MailSent;
end;


procedure TForm1.Button1Click(Sender: TObject);
const
  olMailItem = 0;
var
  Outlook: OleVariant;
  CPContainer: IConnectionPointContainer;
  ConnectionPoint: IConnectionPoint;
begin
  Outlook := CreateOleObject('Outlook.Application');
  FMailItem := Outlook.CreateItem(olMailItem);
  FMailItem.Recipients.add('username@example.com');

  if Supports(FMailItem, IConnectionPointContainer, CPContainer) then begin
    CPContainer.FindConnectionPoint(DIID_ItemEvents, ConnectionPoint);
    if Assigned(ConnectionPoint) then
      ConnectionPoint.Advise(Self, FCookie);
    CPContainer := nil;
  end;

  FMailItem.Display(True);

  if Assigned(ConnectionPoint) then begin
    ConnectionPoint.Unadvise(FCookie);
    ConnectionPoint := nil;
  end;

  VarClear(FMailItem);
  VarClear(Outlook);
end;

procedure TForm1.MailSent;
begin
  ShowMessage(FMailItem.Body);
end;

Answer 2

Я придумал это решение с использованием VBA, которое решает первую часть вашего вопроса. Он в основном полагается на обработку ошибок, чтобы определить, было ли отправлено электронное письмо.

Public Sub SendEmail()
    On Error GoTo ErrorHandler

    Dim objOutlook As Outlook.Application
    Dim objMailItem As Outlook.MailItem

    Do
        Set objOutlook = New Outlook.Application
        Set objMailItem = objOutlook.CreateItem(olMailItem)

        With objMailItem
            .BodyFormat = olFormatHTML

            .To = "test@email.com"
            .Subject = "Test"
            .HTMLBody = "<html><body>Test</body></html>"

            .Display True

            If .Saved Then
                MsgBox "Your email was saved, but not sent. Please click OK and then click the Send " & _
                    "button once the email is displayed. You can delete the saved email from your " & _
                    "Drafts folder at a later time.", vbOKOnly, "Error"
            Else
                MsgBox "Your email was not sent. Please click OK and then click the Send " & _
                    "button once the email is displayed.", vbOKOnly, "Error"
            End If
        End With
    Loop While Not objMailItem.Sent

    Set objMailItem = Nothing
    Set objOutlook = Nothing

    Exit Sub

ErrorHandler:
    Select Case Err.DESCRIPTION
        Case "The item has been moved or deleted.":
            ' The email was sent, so it's no longer available, just clean up and exit.
            Set objMailItem = Nothing
            Set objOutlook = Nothing

        Case Else
            With Err
                .Raise .Number, .Source, .DESCRIPTION, .HelpFile, .HelpContext
            End With

    End Select
End Sub