Outlook Object Model - Detecting if email has been

问题:

I have the following code in my test Delphi 2006 BDS application:

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('[e-mail]');
    vMailItem.Display(True); -- outlook mail message is displayed modally
  except
  end;

  VarClear(Outlook);
end;

I need to be able to detect whether the user sent the email from within the outlook screen. I tried the following code:

if vMailItem.Sent then
 ...

But received the error message 'The item has been moved or deleted'. I presume this is because the mail item has moved to the sent items folder. What is the best way to detect if the user sent the email? Also, if the user did send the email then I would also need to be able to view the email body.

Thanks in advance.

回答1:

It would seem you have to use the Send Event of the mail item. This would be a lot easier if you were using early binding, put one of the 'outlook[*].pas' files in the '..\OCX\Servers' folder of RAD studio in the 'uses' clause, then:

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('[e-mail]');
    MailItem.Display(True);
  finally
    Mail.Free;
  end;
end;

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

With late binding, you'd have to do some of the work which the imported wrapper does. The simplest example could be something like this:

 
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('[e-mail]');

  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;

回答2:

I came up with this solution using VBA that addresses the first part of your question. It basically relies on error handling to determine if the email WAS sent.

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 = "[e-mail]"
            .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