Outlook對象模型 - 檢測是否電子郵件已經發送

Question

我在我的測試德爾福2006年BDS應用程序下面的代碼：

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。如果您使用的是早期綁定，那麼這會更容易，在'uses'子句中將'outlook \ *。pas'文件中的一個放入RAD studio的'.. \ OCX \ Servers'文件夾中，然後：

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