Question

VBA Excel用Outlook发邮件，怎么让邮件发送成功后，再退出？

我在用VBA 调用Outlook发送邮件是正常的，但是会出现邮件还没发送完成，outlook应用就退出了的状况（邮件附件在6MB左右）。怎么去判断邮件发送成功呢？或者有没有一种方法，能延时outlook应用的退出？或者说有没有一种更高效的发送邮件的方式？

Answer 1

Sub SendEmail()
Dim OutlookApp As Outlook.Application
Dim OutlookItem As Outlook.MailItem
Dim AttachedObject(6) As Variant
Set OutlookApp = New Outlook.Application
Set OutlookItem = Outlook.createItem(oLMailItem)
Receiver = Sheets("邮件发送").[C1].Value
ToCC = Sheets("邮件发送").[C2].Value
SubjectText = Sheets("邮件发送").[C3].Value
BodyText = Sheets("邮件发送").[C4].Value & Chr(10) & Sheets("邮件发送").[D4].Value

For m = 1 To 6
AttachedObject(m) = Sheets("邮件发送").Cells(m + 4, 3).Value '附件路径
Next m
If Receiver = "" Then MsgBox "没有发件人，请确认！", vbDefaultButton2, "信息提示": Exit Sub

On Error GoTo SendEmail_Error
With OutlookItem
.To = Receiver
.Subject = SubjectText
.Body = BodyText
.CC = ToCC

For i = 1 To 6
If AttachedObject(i) <> "" Then .Attachments.Add AttachedObject(i)
Next i

.Send
End With
Sheets("邮件发送").Range("A1") = Sheets("邮件发送").Range("A1").Value + 1
Call 已发列表
Sheets("邮件发送").Range("c:c").ClearContents
MsgBox "发送成功！", vbDefaultButton2, "提示"
ThisWorkbook.Save
SendEmail_Exit:
Exit Sub

SendEmail_Error:
MsgBox Err.Description
Resume SendEmail_Exit
End Sub