Send email from Excel in Exchange environment

I have a userform that helps different users fill in data into the spreadsheet. As soon as the data is inserted i开发者_如何学运维t should also be sent by email to a few recipients, depending on the options filled in the form.

This happens within a corporate environment using Exchange. I would create a new email account for this file to be able to send the email as an entity and not use the user's email account.

Is this possible? How? I have googled for it and all I can find is how to create a mail message that the user sends from his account.

---

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!

---

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

---

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.