使用 Excel VBA 在本地 windows 文件夹中将电子邮件另存为 .msg

Question

我想使用 Excel VBA 将电子邮件保存在我的本地文件夹中。

我看到了这个链接https://www.mrexcel.com/forum/excel-questions/361751-vba-saving-email-only-after-send-pushed.html，它使用类模块来保存电子邮件。它在打开电子邮件进行显示的同时存储电子邮件。保存的电子邮件是草稿电子邮件。您仍然可以编辑保存的 .msg 文件。

我将如何等到电子邮件发送完毕？大概是一旦它检测到 Outlook“已发送邮件”文件夹中的电子邮件？

Dim cls_OL As New clsOutlook
Public outMail As Outlook.MailItem
Public Emailpath As String

Sub SendEmail()
Dim objItems As Items
Dim objApp As Object
Set objApp = CreateObject("Outlook.Application")
Set cls_OL.obj_OL = GetObject(Class:="Outlook.Application")
Set OutMail = objItems.Add
Emailpath = "V:\test\emailname.msg"
With OutMail
On Error Resume Next
    .HTMLBody = "Hi All, This is test email" 
    .to = "test@test.com"
    .CC = vbnullstring
    .BCC = vbnullstring
    .Subject = "A Subject"
    .Display
End With
Set OutMail = Nothing
End Sub

.

Option Explicit
Public WithEvents obj_OL As Outlook.Application

Private Sub obj_OL_ItemSend(ByVal Item As Object, Cancel As Boolean)
  Item.SaveAs Emailpath
  Set obj_OL = Nothing
  Set outMail = Nothing
End Sub

这是正在保存的电子邮件：

这是我要保存的内容：

根据 Dmitry 的建议进行编辑

Dim cls_OL As New clsOutlook
Public outMail As Outlook.MailItem
Public Emailpath As String

Sub SendEmail()
Dim objItems As Items
Dim Emailpath as string
Dim objApp as object
Set objApp = CreateObject("Outlook.Application")
Set objItems = objApp.Session.GetDefaultFolder(olFolderSentMail).Items
Set OutMail = objItems.Add 
Emailpath = "V:\test\emailname.msg"
With OutMail

    .HTMLBody = "Hi All, This is test email" 
    .to = "test@test.com"
    .CC = vbnullstring
    .BCC = vbnullstring
    .Subject = "A Subject"
    .Display
End With
Set OutMail = Nothing
End Sub

.

Option Explicit
Public WithEvents objItems As Outlook.Application

Private Sub objItems_ItemAdd(ByVal Item As Object)
  Item.SaveAs Emailpath
  Set obj_OL = Nothing
  Set outMail = Nothing
End Sub

Answer 1

您可以在“已发送邮件”文件夹中侦听Items.ItemAdd 事件（您可以使用Namespace.GetDEfaultFolder(olFolderSentMail) 检索它）。

编辑：在我脑海中浮现：

public WithEvents objItems As Outlook.Items
set objItems = Application.Session.GetDefaultFolder(olFolderSentMail).Items
...
Private objItems_ItemAdd(ByVal Item As Object)
  Item.SaveAs Emailpath
End Sub