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

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