EXCEL VBA，手动Outlook电子邮件发件人，类模块问题

我仍然在处理我在第一个关于这个主题的问题中所描述的问题 。 简短的刷新，它是一个Excel文件，其中包含电子邮件模板和附件的列表，对每个列表单元我添加打开给定单元的模板的button，使有一些变化，然后附加文件，并显示邮件到用户。 用户可以根据需要修改邮件，然后发送或不发送邮件。 我已经尝试了下面描述的几种方法。 不幸的是，我现在在类模块的问题上停滞不前， 这里简要描述。 我已经创build了一个类模块，比如'EmailWatcher'，甚至与这里描述的方法做一个小的组合：

Option Explicit Public WithEvents TheMail As Outlook.MailItem Private Sub Class_Terminate() Debug.Print "Terminate " & Now() End Sub Public Sub INIT(x As Outlook.MailItem) Set TheMail = x End Sub Private Sub x_Send(Cancel As Boolean) Debug.Print "Send " & Now() ThisWorkbook.Worksheets(1).Range("J5") = Now() 'enter code here End Sub Private Sub Class_Initialize() Debug.Print "Initialize " & Now() End Sub 

以下表单的更改不做任何更改：

 Option Explicit Public WithEvents TheMail As Outlook.MailItem Private Sub Class_Terminate() Debug.Print "Terminate " & Now() End Sub Public Sub INIT(x As Outlook.MailItem) Set TheMail = x End Sub Private Sub TheMail_Send(Cancel As Boolean) Debug.Print "Send " & Now() ThisWorkbook.Worksheets(1).Range("J5") = Now() 'enter code here End Sub Private Sub Class_Initialize() Debug.Print "Initialize " & Now() End Sub 

模块代码如下：

 Public Sub SendTo() Dim r, c As Integer Dim b As Object Set b = ActiveSheet.Buttons(Application.Caller) With b.TopLeftCell r = .Row c = .Column End With Dim filename As String, subject1 As String, path1, path2, wb As String Dim wbk As Workbook filename = ThisWorkbook.Worksheets(1).Cells(r, c + 5) path1 = Application.ThisWorkbook.Path & ThisWorkbook.Worksheets(1).Range("F4") path2 = Application.ThisWorkbook.Path & ThisWorkbook.Worksheets(1).Range("F6") wb = ThisWorkbook.Worksheets(1).Cells(r, c + 8) Dim outapp As Outlook.Application Dim oMail As Outlook.MailItem Set outapp = New Outlook.Application Set oMail = outapp.CreateItemFromTemplate(path1 & filename) subject1 = oMail.subject subject1 = Left(subject1, Len(subject1) - 10) & Format(ThisWorkbook.Worksheets(1).Range("D7"), "DD/MM/YYYY") oMail.Display Dim CurrWatcher As EmailWatcher Set CurrWatcher = New EmailWatcher CurrWatcher.INIT oMail Set CurrWatcher.TheMail = oMail Set wbk = Workbooks.Open(filename:=path2 & wb) wbk.Worksheets(1).Range("I4") = ThisWorkbook.Worksheets(1).Range("D7").Value wbk.Close True ThisWorkbook.Worksheets(1).Cells(r, c + 4) = subject1 With oMail .subject = subject1 .Attachments.Add (path2 & wb) End With With ThisWorkbook.Worksheets(1).Cells(r, c - 2) .Value = Now .Font.Color = vbWhite End With With ThisWorkbook.Worksheets(1).Cells(r, c - 1) .Value = "Was opened" .Select End With End Sub 

最后，我做了一个正在工作的类，我已经把一些控件来检查它，你可以从类模块代码中看到。 但问题是，它不捕获发送事件。 这个类正在终止于子结尾。 将电子邮件完全留给用户。 问题是：哪里出错？ 或者如何离开class级模块所谓的“等待模式”，或者其他任何build议？ 我也考虑在“发件箱”中search邮件的方式，但发送事件的方式更受青睐。

Answer 1

我在这里回答了一个类似的问题，并且仔细查看了一下，我认为，当你在正确的轨道上时，你的实现有一些问题。 试试这个：

像这样做Class模块，摆脱不必要的INIT过程，并使用Mailitem过程来创buildMailitem 。

 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() ThisWorkbook.Worksheets(1).Range("J5") = Now() 'enter code here End Sub Private Sub Class_Initialize() Debug.Print "Initialize " & Now() 'Have Outlook create a new mailitem and get a handle on this class events Set TheMail = olApp.CreateItem(0) End Sub 

在正常模块中使用的例子，经过testing和确认这是可行的，将处理多个电子邮件（我以前的答案没有完成）。

 Option Explicit Public olApp As Outlook.Application Public WatchEmails As New Collection Sub SendEmail() If olApp Is Nothing Then Set olApp = CreateObject("Outlook.Application") Dim thisMail As New EmailWatcher WatchEmails.Add thisMail thisMail.TheMail.Display thisMail.TheMail.To = "[e-mail]" thisMail.TheMail.Subject = "test" thisMail.TheMail.Display End Sub 

它是如何工作的？ 首先，我们确保我们有一个Outlook.Application实例来处理。 这将作为模块中的Public范围，以便其他程序和类可用。

然后，我们创build一个我们的EmailWatcher类的新实例，它引发了EmailWatcher事件。 我们利用这个事件，以及已经处理的Outlook.Application实例来创build和分配TheMail对象事件处理程序。

我们将这些存储在一个Public集合中，以便即使在SendMail过程运行时间结束后，它们仍然在范围内。 这样你可以创build几个邮件，并且他们都会监视它们的事件。

从这一点开始， thisMail.TheMail代表其事件在Excel下受监视的MailItem ，并且通过VBA调用该对象的.Send方法或手动发送电子邮件应该引发TheMail_Send事件过程。

Answer 2

Dim CurrWatcher As EmailWatcher

这条线需要是全局的，而不是任何子程序。

Answer 3

非常感谢您的帮助和支持，我终于做到了。

正如我使用邮件模板，需要一些时间来弄清楚如何将它们添加到collections。

这是我的解决scheme。 class级模块：

 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() Call overwrite(r, c) 'enter code here End Sub Private Sub Class_Initialize() Debug.Print "Initialize " & Now() 'Have Outlook create a new mailitem and get a handle on this class events Set themail = OutApp.CreateItem(0) Set themail = oMail End Sub 

模块：

 Public Sub SendTo1() Dim r, c As Integer Dim b As Object Set b = ActiveSheet.Buttons(Application.Caller) With b.TopLeftCell r = .Row c = .Column End With Dim filename As String, subject1 As String, path1, path2, wb As String Dim wbk As Workbook filename = ThisWorkbook.Worksheets(1).Cells(r, c + 5) path1 = Application.ThisWorkbook.Path & ThisWorkbook.Worksheets(1).Range("F4") path2 = Application.ThisWorkbook.Path & ThisWorkbook.Worksheets(1).Range("F6") wb = ThisWorkbook.Worksheets(1).Cells(r, c + 8) Dim OutApp As Outlook.Application Dim oMail As Outlook.MailItem Set OutApp = New Outlook.Application Set oMail = OutApp.CreateItemFromTemplate(path1 & filename) oMail.Display subject1 = oMail.subject subject1 = Left(subject1, Len(subject1) - 10) & Format(ThisWorkbook.Worksheets(1).Range("D7"), "DD/MM/YYYY") Dim currwatcher As EmailWatcher Set currwatcher = New EmailWatcher currwatcher.INIT oMail Set currwatcher.themail = oMail Set wbk = Workbooks.Open(filename:=path2 & wb) wbk.Worksheets(1).Range("I4") = ThisWorkbook.Worksheets(1).Range("D7").Value wbk.Close True ThisWorkbook.Worksheets(1).Cells(r, c + 4) = subject1 With oMail .subject = subject1 .Attachments.Add (path2 & wb) End With With ThisWorkbook.Worksheets(1).Cells(r, c - 2) .Value = Now .Font.Color = vbWhite End With With ThisWorkbook.Worksheets(1).Cells(r, c - 1) .Value = "Was opened" .Select End With Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub