Сохранить электронную почту как MSG в локальной папке Windows, используя Excel VBA - PullRequest
0 голосов
/ 31 октября 2018

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

Это электронное письмо, которое сохраняется: Draft Email

Это то, что я хочу сохранить: Sent Email

Редактировать с предложением от Дмитрия

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

1 Ответ

0 голосов
/ 01 ноября 2018

Вы можете прослушать событие 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
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...