I have a userform that helps different users fill in data into the spreadsheet. As soon as the data is inserted it 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
.
来源:https://stackoverflow.com/questions/6122747/send-email-from-excel-in-exchange-environment