Using cdo in MS Access VBA to automate email

[agodfried]

I am trying to use cdo to send emails with attachments from Access 2003 sp3.
I am able to establish a mapi session and to specify the message, subject,
and attachment and I am able to add recipients. When I try to specify the
recipient's address, I get an invalid argument error even though the
documentation says that the address is read/write. If I try to use the
recipient.name field, when I execute the .resolve method, the Access hangs
and needs to be terminated.

Can these behaviors be caused by having the Outlook Security Patch
installed? How can I tell if the patch is installed?

Has anyone gotten cdo to work from Access using Outlook as the mail app?

 

[Ralph]

Your question is a little confusing. You should post the code you are trying
to use.

 

[agodfried]

Here is the code which I have working on another computer running Vista and
Office 2003:

Function SendCDOMessage( _
strMessage As String, _
strSubject As String, _
strAttachmentFileName As String, _
strAttachmentName As String, _
ParamArray varRecipients() As Variant _
)
Dim errObj As Long
Dim errMsg As String
Dim varArg As Variant
Dim cdoObj As CdoObjectClass
Dim objSession As MAPI.Session
Dim objMessage As Message
Dim objOneRecip As Recipient
Dim objAttach As Attachment
Dim intPtr As Integer

On Error GoTo CDOTrap

' Create the CDO Session.
Set objSession = CreateObject("MAPI.Session")

' Log on to the session. If the ProfileName argument is omitted,
' Microsoft Exchange prompts you for the profile to use. If the
' profile name is incorrect, you receive a runtime error.

objSession.Logon

' create a message and fill in its properties
Set objMessage = objSession.Outbox.Messages.Add
With objMessage
.Subject = strSubject
.Text = strMessage

'Set the recipients
For intPtr = 0 To UBound(varRecipients)
Set objOneRecip = .Recipients.Add
objOneRecip.Address = varRecipients(intPtr)
objOneRecip.Type = CdoTo
' objOneRecip.Name = varRecipients(intPtr)
' objOneRecip.Resolve
Next intPtr

.Text = " " & objMessage.Text ' add placeholder for attachment

Set objAttach = .Attachments.Add ' add the attachment
If objAttach Is Nothing Then
MsgBox "Unable to create new Attachment object"
GoTo CDOExit
End If

With objAttach
.Type = CdoFileData
.Position = 0 ' render at first character of message
.Name = strAttachmentName
.ReadFromFile strAttachmentFileName
End With

objAttach.Name = "smiley.bmp"
.Update ' update message to save attachment in CDO system
.Send showDialog:=False
End With
MsgBox "The message has been sent"
objSession.Logoff

CDOExit:
Exit Function

CDOTrap:
errObj = Err - vbObjectError ' Strip out the OLE automation error.
Select Case errObj
Case 275 ' User cancelled sending of message.
Resume CDOExit
Case Else
errMsg = MsgBox("Error " & errObj & " was returned.")
Resume CDOExit
End Select
End Function

 

[Ralph]

Set objOneRecip=.Recipients.Add(varRecipients(intPtr))

worked for me. Also keep in mind cdo does not exist in Access 2007.

 

[agodfried]

Was able to get this to work on the Vista machine by changing .Send
showDialog:=False to .Send showDialog:=True. When I did this a dialog
warning me about third part trying to send email via outlook appeared and
when I selected to allow this, the email got sent. However when I run the
same code on the XP machine, the code hangs at the .resolve line.

Also, I am unable to set the .address of the recipient. I get an invalid
argument error message. It looks to me like this should be possible. This
is the way I want to do it anyway since I have the email addresses but not
Outlook contacts established.

How do I need to do this in Office 2007 if cdo isn't available?

 

[Ralph]

If the email addresses are not in Outlook then you cannot resolve them. I am
confused by that, sorry. To add an address use:
Set objOneRecip=.Recipients.Add("(e-mail address removed)")

I use the Outlook object model in Office 2007, you can use it in 2003 too.
In the past I used cdo when I wanted to get an ACCOUNT,DISPLAY_NAME,
OFFICE_LOCATION, etc from an address entry. It can be done now using the new
Outlook object model. I am no expert so it took me awhile to convert from cdo
to 2007. Below is a sample for sending emails.

Sub sendOlMail()
Dim olApp As Outlook.Application
Dim olNS As Outlook.NameSpace
Dim itmMail As Outlook.MailItem
Dim olAddress() As String
Dim i As Integer

olAddress = Split("(e-mail address removed),[email protected]", ",")

Set olApp = New Outlook.Application
Set olNS = olApp.GetNamespace("MAPI")
Set itmMail = olApp.CreateItem(olMailItem)

With itmMail
For i = 0 To UBound(olAddress)
With .Recipients.Add(olAddress(i))
.Type = olTo
End With

Next
.Attachments.Add ("c:\temp\read_me.doc")
.Send
End With

Set olNS = Nothing
Set itmMail = Nothing
Set olApp = Nothing
End Sub

 

[agodfried]

Since this code should work in 2003 and 2007 I will try it and let you know
how I make out. Thanks.

 

[agodfried]

I used your code and it worked like a charm . Thanks. One more question:
Is there a limit to the number of recipients that can be added to the email?
If so, do you know offhand what the limit is?

 

[agodfried]

One more question: Is there a way to change the vba reference to the outlook
library from vba code or in a startup or initialization routine. I have
users using Office 2003 and now some will be using Office 2007.

 

[Ralph]

I am not sure about the number of email addresses. You might try that
question in one of the Outlook forums. Use late binding so you don't need to
set a reference to the Outlook Object Library.

Sub sendOlMail()
Const olMailItem = 0
Const olTo = 1
Dim olApp As Object
Dim olNS As Object
Dim itmMail As Object
Dim olAddress() As String
Dim i As Integer

olAddress = Split("(e-mail address removed),[email protected]", ",")

Set olApp = CreateObject("Outlook.Application")
Set olNS = olApp.GetNamespace("MAPI")
Set itmMail = olApp.CreateItem(olMailItem)

With itmMail
For i = 0 To UBound(olAddress)
With .Recipients.Add(olAddress(i))
.Type = olTo
End With

Next
.Attachments.Add ("c:\temp\read_me.doc")
.Send
End With

Set olNS = Nothing
Set itmMail = Nothing
Set olApp = Nothing
End Sub

 

[agodfried]

Thanks. Late binding is a good solution!