在 Exchange 环境中从 Excel 发送电子邮件

Question

我有一个用户表单，可以帮助不同的用户将数据填写到电子表格中。插入数据后，还应通过电子邮件将其发送给几个收件人，具体取决于表单中填写的选项。

这发生在使用 Exchange 的公司环境中。我会为此文件创建一个新的电子邮件帐户，以便能够将电子邮件作为一个实体发送，而不是使用用户的电子邮件帐户。

这可能吗？如何？我已经用谷歌搜索了它，我只能找到如何创建用户从他的帐户发送的邮件。

Answer 1

我使用下面的代码 (source) 从 Excel-VBA 发送电子邮件。我只用我自己的电子邮件帐户对其进行了测试，但我假设您可以让它从不同的帐户 (msgOne.from = ...) 发送邮件，只要用户有权从 Exchange 服务器上的该帐户发送邮件。

Dim cdoConfig
Dim msgOne

Set cdoConfig = CreateObject("CDO.Configuration")
With cdoConfig.Fields
    .Item(cdoSendUsingMethod) = cdoSendUsingPort
    .Item(cdoSMTPServerPort) = 25 '465 ' (your port number) usually is 25
    .Item(cdoSMTPServer) = "smtp.mysmtpserver.com" ' your SMTP server goes here
    '.Item(cdoSendUserName) = "My Username"
    '.Item(cdoSendPassword) = "myPassword"
    .Update
End With

Set msgOne = CreateObject("CDO.Message")
Set msgOne.Configuration = cdoConfig
msgOne.To = "someone@somewhere.com"
msgOne.from = "me@here.com"
msgOne.subject = "Test CDO"
msgOne.TextBody = "It works just fine."
msgOne.Send

很遗憾，我目前无法检验这个假设，因为我只设置为从一个帐户发送。告诉我结果如何！

Answer 2

如果 excel 应用程序在装有 Outlook 的机器上运行，您可以按照以下方式进行操作。

Function SendEmailWithOutlook(er As emailRecord, 
           recipients As String, 
           cc As String, 
           subject As String, 
           body As String, 
           attachmentPath As String) As Boolean
    Dim errorMsg As String
    Dim OutApp As Object
    Dim OutMail As Object
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    On Error GoTo errHandle
    If (er.useTestEmail = True) Then
        recipients = er.emailTest
        cc = er.emailTest
    End If
    With OutMail
        If er.emailFrom <> "" Then
            .sentOnBehalfOfName = er.emailFrom
        End If
        .To = recipients
        .cc = cc
        .bcc = er.emailBcc
        .subject = subject
        .htmlBody = body
        If attachmentPath <> "" Then
            .Attachments.Add attachmentPath
        End If
        .Send   'or use .Display
    End With
    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing
    SendEmailWithOutlook = True
    Exit Function
errHandle:
    errorMsg = "Error sending mail via outlook: " & Err.Description & vbCrLf
    errorMsg = errorMsg & "OnBehalfOf:" & er.emailFrom & vbCrLf
    errorMsg = errorMsg & "Recipients: " & recipients & vbCrLf
    errorMsg = errorMsg & "CC: " & cc & vbCrLf
    errorMsg = errorMsg & "BCC: " & er.emailBcc
    MsgBox errorMsg
    SendEmailWithOutlook = False
End Function

添加对 Microsoft Outlook 14.0 对象库的引用

Answer 3

为什么不使用 Outlook 对象模型？

您可以赋予当前用户代表指定用户发送的权限，然后在调用MailItem.Send之前设置MailItem.SentOnBehalfOfName和MailItem.ReplyRecipients（如果需要）属性。