EXCEL VBA，手动 Outlook 电子邮件发件人，Class 模块问题
EXCEL VBA, Manual Outlook email sender, Class module Issue
我仍在处理我在 1st question 中描述的关于此主题的问题。对于简短的刷新，它是一个包含电子邮件模板和附件列表的 excel 文件，我在每个列表单元中添加了打开给定单元模板的按钮，在那里进行一些更改，然后附加文件并显示给用户的邮件。用户可以根据需要修改邮件，然后发送或不发送邮件。我尝试了下面描述的几种方法。
不幸的是，我现在在 class 模块的问题上停滞不前，该模块简要描述了 here. I do have created a class module, such as 'EmailWatcher' and even make a small combination with method described here:
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，我已经放置了一些控件来检查它，正如您从 class 模块代码中看到的那样。但问题是，它没有捕捉到 Send 事件。 class 在 sub 的末尾终止。将电子邮件完全留给用户。问题是：错误在哪里？或者如何让 class 模块处于所谓的“等待模式”，或者任何其他建议？
我也考虑过在 'outbox' 中搜索邮件的方法，但是发送事件的方法更受欢迎。
Dim CurrWatcher As EmailWatcher
此行必须是全局的，在任何子例程之外。
我回答了一个类似的问题 并查看了该问题，我认为虽然您在正确的轨道上，但您的实施存在一些问题。试试这个：
照此操作 Class 模块，去掉不必要的 INIT 过程并使用 Class_Initialize 过程创建 Mailitem.
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
在普通模块中使用的示例，经过测试并确认这是有效的，并将处理 多封 电子邮件（我之前的回答没有完成）。
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 = "someone@email.com"
thisMail.TheMail.Subject = "test"
thisMail.TheMail.Display
End Sub
效果如何？首先，我们确保我们有一个 Outlook.Application 实例可以使用。这将在模块中被限定为 Public，因此它可用于其他过程 & classes.
然后，我们创建 EmailWatcher class 的新实例，它会引发 Class_Initialize 事件。我们利用此事件和已处理的 Outlook.Application 实例来创建和分配 TheMail 对象事件处理程序。
我们将它们存储在 Public 集合中，这样即使在 SendMail 过程运行时结束后它们仍保留在范围内。这样您就可以创建多封电子邮件，它们的事件都会受到监控。
从那时起，thisMail.TheMail 代表 MailItem 其事件在 Excel 下被监视，并在此对象上调用 .Send 方法（通过 VBA) 或手动发送电子邮件应引发 TheMail_Send 事件过程。
感谢大家的帮助和支持，终于搞定了
因为我确实使用邮件模板，所以需要一些时间来弄清楚如何将它们添加到 collection。
这是我的解决方案。
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
我仍在处理我在 1st question 中描述的关于此主题的问题。对于简短的刷新，它是一个包含电子邮件模板和附件列表的 excel 文件，我在每个列表单元中添加了打开给定单元模板的按钮，在那里进行一些更改，然后附加文件并显示给用户的邮件。用户可以根据需要修改邮件，然后发送或不发送邮件。我尝试了下面描述的几种方法。 不幸的是，我现在在 class 模块的问题上停滞不前，该模块简要描述了 here. I do have created a class module, such as 'EmailWatcher' and even make a small combination with method described here:
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，我已经放置了一些控件来检查它，正如您从 class 模块代码中看到的那样。但问题是，它没有捕捉到 Send 事件。 class 在 sub 的末尾终止。将电子邮件完全留给用户。问题是：错误在哪里？或者如何让 class 模块处于所谓的“等待模式”，或者任何其他建议？ 我也考虑过在 'outbox' 中搜索邮件的方法，但是发送事件的方法更受欢迎。
Dim CurrWatcher As EmailWatcher
此行必须是全局的，在任何子例程之外。
我回答了一个类似的问题
照此操作 Class 模块，去掉不必要的 INIT 过程并使用 Class_Initialize 过程创建 Mailitem.
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
在普通模块中使用的示例，经过测试并确认这是有效的，并将处理 多封 电子邮件（我之前的回答没有完成）。
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 = "someone@email.com"
thisMail.TheMail.Subject = "test"
thisMail.TheMail.Display
End Sub
效果如何？首先，我们确保我们有一个 Outlook.Application 实例可以使用。这将在模块中被限定为 Public，因此它可用于其他过程 & classes.
然后，我们创建 EmailWatcher class 的新实例，它会引发 Class_Initialize 事件。我们利用此事件和已处理的 Outlook.Application 实例来创建和分配 TheMail 对象事件处理程序。
我们将它们存储在 Public 集合中，这样即使在 SendMail 过程运行时结束后它们仍保留在范围内。这样您就可以创建多封电子邮件，它们的事件都会受到监控。
从那时起，thisMail.TheMail 代表 MailItem 其事件在 Excel 下被监视，并在此对象上调用 .Send 方法（通过 VBA) 或手动发送电子邮件应引发 TheMail_Send 事件过程。
感谢大家的帮助和支持，终于搞定了
因为我确实使用邮件模板，所以需要一些时间来弄清楚如何将它们添加到 collection。
这是我的解决方案。 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