1

我仍在研究我在关于该主题的第一个问题中描述的问题。对于短暂的刷新，它是一个包含电子邮件模板和附件列表的 excel 文件，我在每个列表单元中添加了打开发送单元模板的按钮进行一些更改，然后附加文件并将邮件显示到用户。用户可以根据需要修改邮件，然后发送或不发送邮件。我尝试了下面描述的几种方法。不幸的是，我现在在类模块的问题上停滞不前，在这里简要描述了。我确实创建了一个类模块，例如“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

最后，我创建了一个正在运行的类，并且我已经放置了一些控件来检查它，正如您从类模块代码中看到的那样。但问题是，它没有捕捉到 Send 事件。该类在子结束时终止。将电子邮件完全留给用户。问题是：错误在哪里？或者如何让类模块处于所谓的“等待模式”，或者任何其他建议？因此，我也考虑在“发件箱”中搜索邮件的方法，但发送事件的方法更受欢迎。

4

3 回答 3

1

Dim CurrWatcher As EmailWatcher

这条线需要是全局的，在任何子程序之外。

于 2017-05-12T15:17:49.587 回答
1

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

像这样做 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实例。这将被限定为一个Publicin 模块，因此它将可用于其他过程和类。

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

我们将它们存储在一个Public集合中，以便即使在SendMail过程运行时结束后它们仍然在范围内。通过这种方式，您可以创建多封电子邮件，并且它们都会受到监控。

从那时起，thisMail.TheMail表示MailItem在 Excel 下正在监视其事件，并.Send在此对象上调用方法（通过 VBA）或手动发送电子邮件应引发TheMail_Send事件过程。

于 2017-05-12T15:55:27.760 回答
0

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

由于我确实使用了邮件模板，因此需要一些时间来弄清楚如何将它们添加到集合中。

这是我的解决方案。班级模块：

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
于 2017-05-19T09:51:03.577 回答