【发布时间】：2017-02-14 11:34:41
【问题描述】：
我在 Windows 10 上的 MS Access 2013 和 MS Outlook 2013 中工作，我有一个带有“导航子表单”范例的 Access DB，允许在两个不同的场合发送一封电子邮件。
我正在尝试编写代码来执行以下操作：
- 发送新电子邮件时，
- 我想将它自动保存为磁盘上的 .msg 文件。
据我所知，执行此操作的方法似乎是通过捕获在 Access 中的 Outlook 发送文件夹上触发的 .ItemAdd 事件，并在其中执行 .SaveAs 方法。
我试图根据这两个答案实施解决方案：
How to Trap Outlook Events from Excel Application
Utilizing Outlook Events From Excel
但我似乎无法将两者结合起来并触发事件。
我的感觉是 要么我没有正确引用/设置事物，要么在电子邮件从发件箱文件夹移动到已发送文件夹之前执行结束，但我不确定。
我该怎么做？
感谢阅读，代码如下：
我当前的课程模块 - “cSentFolderItem”
Option Explicit
Public WithEvents myOlItems As Outlook.items
Private Sub Class_Initialize()
Dim oNS As NameSpace
Dim myOL As Outlook.Application
Set myOL = New Outlook.Application
Set oNS = myOL.GetNamespace("MAPI")
Set myOlItems = oNS.GetDefaultFolder(olFolderSentMail).items
End Sub
Private Sub myOlItems_ItemAdd(ByVal Item As Object)
Debug.Print "I got a new item on Sent box!"
Dim myOlMItem As Outlook.MailItem
Set myItem = myOlItems.items(email_subject)
myItem.Display
myItem.SaveAs "C:\Users\XXXXXX\Desktop\mail_test.msg", olMSGUnicode
End Sub
“常规”代码：
Public Function GetApplication(Class As String) As Object
'Handles creating/getting the instance of an application class
Dim ret As Object
On Error Resume Next
Set ret = GetObject(, Class)
If Err.Number <> 0 Then
Set ret = CreateObject(Class)
End If
Set GetApplication = ret
On Error GoTo 0
End Function
Sub Test()
email_subject = "Mail test match string - [aaaa-mm-dd]"
Set myOlItems = New cSentFolderItem 'declare class module object
Dim MyOutlook As Outlook.Application
Set MyOutlook = GetApplication("Outlook.Application") 'trying to get correct application object
'The following code is a dummy e-mail creation, after which I press SEND:
Dim MyMail As Outlook.MailItem
varTo = "target_email@address.com"
varSubject = email_subject
varbody = "test line 1" & vbCrLf & "test line 2" & vbCrLf & "test line 2"
varSubject = Replace(varSubject, "[aaaa-mm-dd]", NOW())
Dim linhas() As String
linhas = Split(varbody, vbCrLf)
bodyHTMLtext = "<body>"
For i = 0 To UBound(linhas) - 1
bodyHTMLtext = bodyHTMLtext & linhas(i) & "<br>"
Next
bodyHTMLtext = bodyHTMLtext & linhas(UBound(linhas))
bodyHTMLtext = bodyHTMLtext & "</body>"
Set MyMail = MyOutlook.CreateItem(OLMAILITEM)
MyMail.To = varTo
MyMail.Subject = varSubject
MyMail.Display
MyMail.HTMLBody = bodyHTMLtext & MyMail.HTMLBody
AppActivate varSubject
'trying to leave Outlook object open:
''Cleanup after ourselves
'Set MyMail = Nothing
''MyOutlook.Quit
'Set MyOutlook = Nothing
End Sub
【问题讨论】：
-
那么问题出在哪里？你的代码运行吗？你有没有尝试过它？
-
在您的 myOlItems_ItemAdd 事件句柄中，为什么要按主题检索消息，而不是使用传递给您的项目作为参数？
-
@DmitryStreblechenko：感谢您的评论。正如我在解决方案中提到的那样，我按主题检索邮件，因为我对所有新发送的电子邮件不感兴趣，而是对一些特定的电子邮件感兴趣，我通过他们的主题进行跟踪。
-
好的，所以当 ItemAdd 事件触发时，检查项目的主题。为什么要搜索文件夹中的所有项目？
-
嗯，好的，有道理。谢谢，我会调查的。