更改电子表格时使用 Outlook 从 Excel 自动发送电子邮件

Sending an Automatic Email from Excel Using Outlook When Spreadsheet is Changed

我在让 Outlook 通过 Excel 电子表格发送电子邮件时遇到问题。当我将 Outlook 2013 与 Gmail 一起使用时没有问题,但是当我使用具有唯一域 (someEmail@CreatedDomain.mil) 的先前版本 (2010) 时,我收到错误消息。我想说是因为域,但我不确定。下面是我在网上找到的代码。

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, _
Cancel As Boolean)

    '-----AUTOMATIC EMAIL GENERATION-----------------------
    Dim answer As String

    answer = MsgBox("Saving this document will send an email to the database director and close the database. Are you sure you want to save?", _
        vbYesNo, "Save confirmation")
    '    Above code informs the user
    '    that an automated email will be sent to the database
    '    director and prompts them if they are ready to save

    'Code uses the users answer to either carryout the generated email process or to not save the changes.
    If answer = vbNo Then Cancel = True
    If Cancel = True Then Exit Sub
    If answer = vbYes Then

    'Connects to outlook and retrieves information needed to create and send the email.
    Set OutlookApp = CreateObject("Outlook.Application")
    Set OlObjects = OutlookApp.GetNamespace("MAPI")
    Set newmsg = OutlookApp.CreateItem(olMailItem)

    'Contains the email address of the person receiving the email.
    newmsg.Recipients.Add ("roman.hope.ctr@navy.mil")
    newmsg.Subject = "Automated email from excel database" 'Sets the automated subject line to the email
    newmsg.Body = "There has been a change to the excel database from the person sending linked to this email."
    'Above code has the body of the automated email

    'sets the email to "display" in the background then sends it in the next line of code (all in the background).
    newmsg.Display
    newmsg.Send 'sends the email

    'Displays a confirmation that the email has been sent.
    MsgBox "The email has been successfully sent", , "Email confirmation"
    '    ActiveWorkbook.Save

    End If
End Sub ' End of function

对于 Outlook 2010,我总是使用这种语法,效果很好,甚至不需要命名空间。

Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

On Error Resume Next
With OutMail
    .To = "somebody@something.com"
    .CC = ""
    .BCC = ""
    .Subject = "YOUR SUBJECT"
    .HTMLBody = "your text as html"
    '.Attachments.Add ("path\filema.xsl") 'uncomment for attachment
    '.Display 'uncomment for display
    .Send

End With
On Error GoTo 0

Set OutMail = Nothing
Set OutApp = Nothing

我没有在 Outlook 2013 上尝试过,但是在 2010 上,这会按预期发送电子邮件。 如果您的 Outlook 中有多个邮件帐户,则可能需要进行一些调整以选择正确的帐户。 但是它应该可以工作,因为 CreateItem(0) 通常总是一封新邮件,除非 Microsoft 没有按预期工作。

您也可以将 .HTMLBody 更改为 .Body,它应该可以工作,我只是更喜欢 html 我的邮件格式,因为这样您就可以轻松地在正文中使用附件。

我发现了问题,问题不在于代码,而在于我所在的网络。

网络有一个自动电子邮件保护功能,可以阻止所有应用程序发送自动通用电子邮件。

感谢大家的帮助。