通过 vba 到 msaccess 2013 验证电子邮件是否已发送到 Outlook 2013

Question

我正在努力实现：

1. 电子邮件已发送到 Outlook“已发送邮件”文件夹，因此电子邮件是 不在“发件箱”文件夹中。

2. 由于递送失败，电子邮件未返回（电子邮件将在 “收件箱”文件夹由 postmaster@mail.hotmail.com 投递）

以下代码用于通过 Outlook 从 Access 表单发送电子邮件：

Private Sub cmdEmail1_Click()
Dim OutApp As Outlook.Application
Dim OutMail As Outlook.MailItem
Dim strBody As String
Dim strPDF As String
Dim strFolder As String

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(olMailItem)

strBody = Me.txtSubject
strPDF = Me.txtFile
On Error Resume Next
With OutMail
    .To = Me.txtemail
    .CC = ""
    .BCC = Me.txtBBCemail
    .Subject = Me.txtSubject
    .Body = Me.txtMessage
    .Recipients.ResolveAll
'   .SendUsingAccount =   OutApp.Session.Accounts.Item(2)                         '2nd email
    .SentOnBehalfOfName = Me.txtFromEmail
    .Attachments.Add        strPDF                                                    'attachments
    .Send

End With
Me.txtSent = "email was sent to Outlook "

On Error GoTo 0

Set OutMail = Nothing
Set OutApp = Nothing
End Sub

非常感谢

诺伯特

Answer 1

这两者都是异步的，您将能够在稍后、几秒甚至几分钟之后处理通知。

我认为#1 不会对您有太大帮助 - 它只会告诉您网络没有断开连接。为什么这有关系？即使它已关闭，Outlook 也会稍后发送该邮件。

对于 #2，这完全取决于谁发送了 NDR。如果是 Exchange，您将能够找出错误的收件人地址。否则，您可能只会收到一条消息，无法确定有问题的收件人是什么。

编辑。对于 Items.ItemAdd，请参阅以下内容（在我的脑海中）：

Dim OutApp As Outlook.Application
Dim WithEvents SentItems As Outlook.Items

sub SentItems_ItemAdd(Item As Object)
  MsgBox Item.Subject
end sub

Private Sub cmdEmail1_Click()

Dim OutMail As Outlook.MailItem
Dim strBody As String
Dim strPDF As String
Dim strFolder As String
Dim ns As Outlook.Namespacee

if (OutApp Is Nothing) Then
  Set OutApp = CreateObject("Outlook.Application")
  set ns = OutApp.GetNamespace("MAPI")
  ns.Logon 
  set SentItems = ns.GetDefaultFolder(olFolderSentMail).Items    
End If
Set OutMail = OutApp.CreateItem(olMailItem)

strBody = Me.txtSubject
strPDF = Me.txtFile
On Error Resume Next
With OutMail
    .To = Me.txtemail
    .CC = ""
    .BCC = Me.txtBBCemail
    .Subject = Me.txtSubject
    .Body = Me.txtMessage
    .Recipients.ResolveAll
'   .SendUsingAccount =   OutApp.Session.Accounts.Item(2)                         '2nd email
    .SentOnBehalfOfName = Me.txtFromEmail
    .Attachments.Add        strPDF                                                    'attachments
    .Send

End With
Me.txtSent = "email was sent to Outlook "

On Error GoTo 0

Set OutMail = Nothing
Set OutApp = Nothing
End Sub