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

时间:2011-05-25 10:09:25

标签: email excel-vba exchange-server vba excel

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

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

这可能吗?怎么样?我用谷歌搜索了它,我能找到的就是如何创建用户从他的帐户发送的邮件消息。

3 个答案:

答案 0 :(得分:4)

我使用下面的代码(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

不幸的是,我现在无法测试这个假设,因为我只设置从一个帐户发送。让我知道它是如何运作的!

答案 1 :(得分: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对象库的引用

答案 2 :(得分:0)

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

您可以授予当前用户代表指定用户发送的权限,然后在callign MailItem.SentOnBehalfOfName之前设置MailItem.ReplyRecipientsMailItem.Send(如有必要)属性。