[AccessD] CDO/Priority flag.

Doug,

  Thanks for that.  Pretty much already there.  Below is what I ended up
with.  Works with low, normal, and high priority.

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 strPriority As String

    Dim objcdoConfig As Object
    Dim objcdoMessage 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." & vbCrLf & vbCrLf
        MsgBox strMsg, vbCritical + vbOKOnly, "Invalid e-mail task name"
    Else
        ' Send the e-mail
        Set objcdoConfig = CreateObject("CDO.Configuration")
        Set objcdoMessage = CreateObject("CDO.Message")
        
        ' Don't rely on configuration settting on client
 
objcdoConfig.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sen
dusing") = rst!SendUsing
 
objcdoConfig.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smt
pserver") = rst!SMTPServer
 
objcdoConfig.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smt
pauthenticate") = rst!SMTPAuthenticate
 
objcdoConfig.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sen
dusername") = rst!SendUserName
 
objcdoConfig.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sen
dpassword") = rst!SendUserPassword
 
objcdoConfig.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sen
dusing") = rst!SendUsing
 
objcdoConfig.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smt
pserverport") = rst!SMTPPort
 
objcdoConfig.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smt
pusessl") = rst!UseSSL
 
objcdoConfig.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smt
pconnectiontimeout") = rst!ConnectTimeout
        objcdoConfig.Fields.Update
 
        With objcdoMessage.Fields
           strPriority = Switch(rst![Priority] = -1, "Low", rst![Priority] =
0, "Normal", rst![Priority] = 1, "High")
           .Item("urn:schemas:mailheader:X-MSMail-Priority") = strPriority
' For Outlook 2003
           .Item("urn:schemas:mailheader:X-Priority") = rst![Priority]    '
For Outlook 2003 also
           .Item("urn:schemas:httpmail:importance") = rst![Priority] + 1 '
For Outlook Express
           .Update
        End With
        
        With objcdoMessage
             Set .Configuration = objcdoConfig
            .From = rst!From
            .To = rst!To
            .CC = rst!CC
            .BCC = rst!BCC
            .Subject = rst!Subject
            .TextBody = rst!Message
            
            .Send
        End With
    End If
    
DoEmailTask_Exit:
    On Error resume next

    Set objcdoConfig = Nothing
    Set objcdoMessage = 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


-----Original Message-----
From: accessd-bounces at databaseadvisors.com
[mailto:accessd-bounces at databaseadvisors.com] On Behalf Of Doug Barnes
Sent: Tuesday, September 23, 2008 9:14 AM
To: Access Developers discussion and problem solving
Subject: Re: [AccessD] CDO/Priority flag.

Here's a snippet of code we use in a vbs script file to send emails with an
importance and priority set:

<<snip>>