Send email from Excel in Exchange environment

半腔热情 提交于 2019-12-01 11:37:05

I've used the code below (source) to send e-mails from Excel-VBA. I've only tested it with my own e-mail account, but I assume you could have it send mail from a different account (msgOne.from = ...), as long as the user has permission to send from that account on the Exchange server.

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

Unfortunately, I can't test this hypothesis at this time, as I'm only set up to send from one account. Let me know how it works out!

vzczc

If the excel application is running on a machine with outlook, you can something along the following.

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

Add a reference to Microsoft Outlook 14.0 Object Library

Dmitry Streblechenko

Why not use the Outlook Object Model?

You can give the current user the right to send on behalf of the specified user, then set MailItem.SentOnBehalfOfName and MailItem.ReplyRecipients (if necessary) properties before callign MailItem.Send.

易学教程内所有资源均来自网络或用户发布的内容,如有违反法律规定的内容欢迎反馈
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!