trypots.nethomeSending Email from Access or Excel using CDO
Sending email is a frequent necessity for Office programs. CDO provides a convenient way to handle routine email automation. I have used CDO with XP and Windows 7 (some users report it is not installed by default in Vista). There is only one provision: to use CDO you need to know the name of your mail server. At work it is usually mail.companyname.com or smtp.companyname.com. At home your internet provider will let you use their mail server but the number of emails will likely be limited to something like 50 or 100 per day to deter spam. If you are already using Outlook you can find the server's name in your Outlook setup properties.
It would be possible to write a simple email function taking an email address, subject, and text message (actually, that is a great way to write your own "hello world" CDO procecure). But there are plenty of other options for an email message. In order to "generalize" this procedure without piling up unused parameters I pass a dictionary object to the function.. The keys for the dictionary items are the property names that you wish to use, and the values are, of course, the property values.
Download SendEmailCDO[verify your download - sha256 checksums]
Here's a bare bones example of using the email function:
Dim dic As Object
Set dic = CreateObject("Scripting.Dictionary")
dic.Add "Subject", "Test"
dic.Add "From", "me@mycompany.com"
dic.Add "To", "you@yourcompany.com"
dic.Add "TextBody", "It works!"
Call SendEmailCDO(dic)
End Sub
Here's another example, this time with attachments and an html message:
Dim dic As Object
Set dic = CreateObject("Scripting.Dictionary")
dic.Add "Subject", "Test"
dic.Add "From", "me@mycompany.com"
dic.Add "To", "you@yourcompany.com"
dic.Add "HTMLBody", "<p>It works!</p>"
dic.Add "AddAttachment", Array("C:\File1.txt","C:\File2.txt")
Call SendEmailCDO(dic)
End Sub
Here is the function itself. Note that it returns a value of 0 for "success" and 1 otherwise (you may prefer True/False, or you may not need any return values at all):
Dim objMessage As Object
Dim i As Long
SendEmailCDO = 1
Set objMessage = CreateObject("CDO.Message")
With objMessage
'--------------
'Properties
On Error Resume Next
.Subject = dic("Subject")
.FROM = dic("From")
.to = dic("To")
.BCC = dic("BCC")
.HTMLBody = dic("HTMLBody")
.TextBody = dic("TextBody")
If dic.Exists("AddAttachment") Then
If IsArray(dic("AddAttachment")) Then
For i = LBound(dic("AddAttachment")) To UBound(dic("AddAttachment"))
.AddAttachment dic("AddAttachment")(i)
Next i
Else
.AddAttachment dic("AddAttachment")
End If
End If
'----------------
'SMTP Settings
On Error GoTo My_Exit:
.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "mail.mycompany.com"
.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
.Configuration.Fields.Update
.Send
SendEmailCDO = 0 '//Successful Exit Code
End With
My_Exit:
Exit Function
ErrHandler:
Resume My_Exit:
End Function
A few extra links:
Send Email Using CDO
Scripting Runtime Dictionary Tutorial