Jim Dettman
jimdettman at verizon.net
Fri Sep 19 12:12:05 CDT 2008
All,
This seems like it should be simple, and yet an internet search turns up a
variety of answers, none of which seems to work. I've never worked with CDO
before, but have instead preferred to use vbSendMail, but I have a client
that wants to go with CDO as that's what is being used with the rest of the
apps they already have.
This is a simple "send an e-mail" based on a table utility. Two things
don't seem to be working right; multiple recipients and setting a priority
flag.
For the multiple recipients, I'm using a semi-colon delimited list. For
the priority flag, I've tried it as part of the configuration setting and as
a change to the message fields (I get an error with this method about being
disconnect from the client and Access then hangs at exit).
Can't believe I've spent the amount of time I have on something that
should be so simple.
Anyone got any insight on this? Code is below.
Jim.
Public Sub DoEmailTask(strTaskName As String)
Dim db As DAO.Database
Dim rst As DAO.Recordset
Dim strSQL As String
Dim strMsg As String
Dim objMessage As Object
On Error GoTo DoEmailTask_Error
Set db = CurrentDb()
strSQL = "SELECT * FROM tblEmailTasks WHERE [EmailTaskName] = '" &
strTaskName & "'"
Set rst = db.OpenRecordset(strSQL)
If rst.RecordCount = 0 Then
' Task name not in table
strMsg = "Mail task name '" & strTaskName & "' was not found in
tblEmailTasks."
MsgBox strMsg, vbCritical + vbOKOnly, "Invalid e-mail task name"
Else
With rst
' Send the e-mail
Set objMessage = CreateObject("CDO.Message")
' Don't rely on configuration settting on client
objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/confi
guration/sendusing") = !SendUsing
objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/confi
guration/smtpserver") = !SMTPServer
objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/confi
guration/smtpauthenticate") = !SMTPAuthenticate
objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/confi
guration/sendusername") = !SendUserName
objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/confi
guration/sendpassword") = !SendUserPassword
objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/confi
guration/sendusing") = !SendUsing
objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/confi
guration/smtpserverport") = !SMTPPort
objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/confi
guration/smtpusessl") = !UseSSL
objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/confi
guration/smtpconnectiontimeout") = !ConnectTimeout
'objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/conf
iguration/priority") = !priority
objMessage.Configuration.Fields.Item("urn:schemas:mailheader:X-MSMail-Priori
ty") = 0
objMessage.Configuration.Fields.Update
Stop
objMessage.From = !From
objMessage.To = !To
objMessage.CC = !CC
objMessage.BCC = !BCC
objMessage.Subject = !Subject
objMessage.TextBody = !Message
objMessage.Send
End With
End If
DoEmailTask_Exit:
Set objMessage = Nothing
If Not rst Is Nothing Then
rst.Close
Set rst = Nothing
End If
Set db = Nothing
Exit Sub
DoEmailTask_Error:
Resume DoEmailTask_Exit
End Sub