OSBlues

I wrote this a while back as I couldn’t find a nice example anywhere for sending SPF compliant CDO.message emails. It also copes with setting message importance which is another awkward thing. Let me know if you have any problems or have any suggestions to improve it.

Sub sendemail(strFrom, strTo, strSender, strBcc, _
   strSubject, strBody, intType, intImportance)
Dim objMessage ' As CDO.Message
objMessage = Server.CreateObject("CDO.Message")
With objMessage
   .Fields("urn:schemas:httpmail:importance").Value = intImportance
   .Fields("urn:schemas:httpmail:priority").Value = intImportance - 1
   Select Case intImportance
      Case 0
         .Fields("urn:schemas:mailheader:X-Priority").Value = 5
      Case 1
         .Fields("urn:schemas:mailheader:X-Priority").Value = 3
      Case 2
         .Fields("urn:schemas:mailheader:X-Priority").Value = 1
      Case Else
         .Fields("urn:schemas:mailheader:X-Priority").Value = 0
   End Select
   .Fields("urn:schemas:mailheader:X-MSMail-Priority").Value = intImportance
   If Not isNull(strSender) and strSender  strFrom then
      .Fields("urn:schemas:mailheader:return-path").Value = strSender
      .Fields("urn:schemas:mailheader:reply-to").Value = strFrom
   End If
   .Fields.Update()
   .To = strTo
   If Not isNull(strSender) and strSender  strFrom then
      .Sender = strSender
   End If
   If Not isNull(strBcc) Then
      .BCC = strBcc
   End If
   .From = strFrom
   .Subject = strSubject
   If CInt(intType) = 1 Then
      .TextBody = strBody
   Else
      .HTMLBody = strBody
   End If
   .Send()
End With
objMessage = Nothing
End Sub

This is generally useful for web generated emails (like send a friend forms etc.), simply specify the users address as strFrom and a generic local address (noreply@mydomain.com) as strSender.

More generally, here are some good CDO examples.