[AccessD] CDO/Priority flag.

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




More information about the AccessD mailing list