如果手动发送电子邮件，则触发代码以记录

Posted 2023-02-19

【中文标题】如果手动发送电子邮件，则触发代码以记录

【英文标题】：Trigger code to record if email sent manually

【发布时间】：2016-10-24 02:21:12

【问题描述】：

我使用 Excel VBA 发送电子邮件。我想记录下消息是否已经发送。

我从another post 获取了一些代码。

我按照描述创建了类，并添加了一些额外的位以查看它是否正常工作。 它初始化，但没有其他任何事情发生。发送邮件后，该类在后台保持打开状态，所以我必须在 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的类模块代码：

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，我认为这可能与未定义的类对象或其他原因有关。有时我会收到警告，此时它正在初始化，然后立即终止而不等待_Send。

在我无法控制的本地授权网络上，在 Windows 7 上使用 Excel 2007。

【问题讨论】：

你那里还有输入代码吗？我认为您将邮件设置为在邮件消失后成为您的沉没类。 Outmail 应该是我认为的类对象wiseowl.co.uk/blog/s242/event-sink.htm

嗯，我想我粘贴不正确，我会编辑它

你试过我的代码了吗？

【参考方案1】：

类

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

m.Send

End Sub

希望对你有帮助

【参考方案2】：

这看起来与在用户窗体运行时显示邮件有关。

我遇到了同样的问题，虽然用户窗体存在，但 Outlook 事件没有注册。为了解决这个问题，我实施了一种 hack：

您的类或用户表单模块中需要一个布尔属性：

Private someBool as Boolean

您需要订阅MailItem.Close Event 并设置新的布尔值：

Private Sub TheMail_Close(Cancel As Boolean)
    someBool = True
End Sub

当显示的电子邮件关闭、发送或保存时引发此事件。

那么你显然需要一个 Property Get 方法：

Public Property Get MailClosed() As Boolean
    MailClosed = someBool
End Property

现在，要处理所有事件，您需要在显示来自的邮件的模块中使用循环：

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

Do Until CurrWatcher.MailClosed
    DoEvents
Loop

[...]

我不确定为什么DoEvents 有效，如果有人能对此有所了解，我会将其添加到我的答案中。