VBA Outlookメール。表示、手動で送信された場合の録音

Question

VBAを使用してExcelから電子メールを送信していますが、メッセージの送信の有無を記録するのは非常に困難です。私はここに別のポストからいくつかのコードを撮影しています

Link

私が説明したとおりにクラスを作成していないし、それが動作しているかどうかを確認するために、いくつかの余分なビットに入れ、それを初期化しますが、その後は何もしていますメールが送信された後でも、クラスは何とかバックグラウンドで開いたままなので、VBEでクラスを停止する必要があります。ここで

は、呼び出し元のコードです：

Sub SendProc2(add As String) 

Set OutApp = CreateObject("Outlook.Application") 
Set OutMail = OutApp.CreateItem(0) 

On Error Resume Next 

With OutMail 
    .To = add 
    .CC = "" 
    .BCC = "" 
    .Subject = ThisWorkbook.Name 
    .Body = Application.WorksheetFunction.VLookup(Worksheets("Data").Range("B135"), Range("formversion"), 2, False) _ 
    & " Attached:" & vbCrLf & vbCrLf & ThisWorkbook.Name 
    .Attachments.add ActiveWorkbook.FullName 
    .Display 'or use .Send 
End With 

Dim CurrWatcher As EmailWatcher 
Set CurrWatcher = New EmailWatcher 
Set CurrWatcher.TheMail = OutMail 

On Error GoTo 0 

Set OutMail = Nothing 
Set OutApp = Nothing 

Unload UserForm4 

End Sub 

、ここEmailWatcherと呼ばれるクラスモジュールのコードです：決して私が何かをかもしれないと思う_Sendを、登録していないようにみえ

Option Explicit 
Public WithEvents TheMail As Outlook.MailItem 

Private Sub Class_Terminate() 

Debug.Print "Terminate " & Now() 

End Sub 

Private Sub TheMail_Send(Cancel As Boolean) 

Debug.Print "Send " & Now() 
'enter code here 

End Sub 

Private Sub Class_Initialize() 

Debug.Print "Initialize " & Now() 

End Sub 

をクラスオブジェクトが定義されていない、または何か他のものと関係があると、私はこれで多くの問題を抱えていました。時にはそれが初期化しているときに警告を受け取ってから、_Sendを待たずにすぐに終了しました。それ以上の情報i必要があるなら私に知らせてください。

Windows 7上でExcel 2007を使用すると、私が制御できない狂ったローカルオーソリティネットワークを使用している可能性があります。

などの標準モジュールの行わ多く、

おかげで、

ダン

Answer 1

私もVBAに新しいものではないんだけど、私は前に授業をやったことがないクラス

Private WithEvents EM As Outlook.MailItem 

Public Sub INIT(x As Outlook.MailItem) 
    Set EM = x 
End Sub 

Private Sub EM_Send(Cancel As Boolean) 

End Sub 

モジュール

Public WATCHER As clsEmailWatch 

Sub EMAIL() 

Dim o As Outlook.Application 
Dim m As Outlook.MailItem 

Set o = New Outlook.Application 
Set m = o.CreateItem(olMailItem) 

Set WATCHER = New clsEmailWatch 
WATCHER.INIT m 

m.To = "xyz@abc.com" 

m.Send 

End Sub 

希望します。