Binaryworld - Send HTML Email via CDO ... [ VB -> Exteral Libs ]

Ever wonder how to send email that looks like a web page? Here is how you do it. Note: You must have CDO for NT referenced for this to work.

Click here to copy the following block

'Sends an email to the appropriate person(s).
'
'From = Email address being sent from
'SendTo = List of email addresses separated by a semicolon. Example:
'    sm@xyz.com; steve@work.com; jane@home.com
'Subject = Text that summarizes what the email is about
'HTMLText = Body of text that is the email
'AttachmentPath = Directory in which the attachment resides
'Attachment = File to send with the email

Sub SendEmailHTML(From As String, SendTo As String, Subject As String, _
  HTMLText As String, Optional AttachmentPath As String, _
  Optional Attachment As String, Optional CC As String)
  Const constRoutine As String = "SendEmailHTML"

  Dim strSendTo As String
  Dim objSendMail As CDONTS.NewMail
  Dim i As Integer

  On Error GoTo ErrorHandler
  'Do not cause the user a major error, just log the error and keep going

  If SendTo = "" Then Exit Sub

  Set objSendMail = New CDONTS.NewMail

  With objSendMail
    On Error Resume Next
    .From = From
    If CC <> "" Then
      .CC = CC
    End If

    On Error GoTo ErrorHandler
    .To = SendTo
    .Subject = Subject
    .Body = HTMLText
    .MailFormat = CdoMailFormats.CdoMailFormatMime
    .BodyFormat = CdoBodyFormats.CdoBodyFormatHTML

    AttachmentPath = Trim$(AttachmentPath)
    If AttachmentPath <> "" Then
      If Right$(AttachmentPath, 1) <> "\" Then
        AttachmentPath = AttachmentPath & "\"
      End If
      .AttachFile (AttachmentPath & Attachment)
    End If
    .Send
  End With

ExitMe:
  Set objSendMail = Nothing
  Exit Sub

ErrorHandler:
  'Send error back
  Err.Raise Err.Number, Err.Source, Err.Description

End Sub