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

问题描述

| 我有一个用户表单，可以帮助不同的用户将数据填写到电子表格中。插入数据后，还应通过电子邮件将其发送给一些收件人，具体取决于表格中填写的选项。 这在使用Exchange的公司环境中发生。我将为此文件创建一个新的电子邮件帐户，以便能够将电子邮件作为实体发送，而不使用用户的电子邮件帐户。 这可能吗？怎么样？我已经用谷歌搜索了，所有我能找到的就是如何创建用户从他的帐户发送的邮件。     

解决方法

我使用下面的代码（源代码）从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 = \"[e-mail]\"
msgOne.from = \"[e-mail]\"
msgOne.subject = \"Test CDO\"
msgOne.TextBody = \"It works just fine.\"
msgOne.Send

不幸的是，由于我仅设置为从一个帐户发送邮件，因此我目前无法检验此假设。让我知道它是如何工作的！     ,如果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对象库的引用     ,为什么不使用Outlook对象模型？ 您可以授予当前用户代表指定用户发送的权限，然后在callign

MailItem.Send

之前设置

MailItem.SentOnBehalfOfName

和

MailItem.ReplyRecipients

（如有必要）属性。