Я хочу сохранить электронную почту в своей локальной папке, используя 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
Это электронное письмо, которое сохраняется:
Это то, что я хочу сохранить:
Редактировать с предложением от Дмитрия
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