Binaryworld - Send Email using CDOSYS. ... [ VB -> Internet ]

This code snippet will show you how to send SMTP email using CDOSYS. CDONTS was old library for Win NT which is discontinued in XP and 2000. CDOSYS is more flexible than CDONTS. The follwoing code will work with VB6 and VB.net without any modification.

From this code you will learn

1) How to attach multiple files.
2) How to request sent receipt.
3) How to send HTML Email.
4) How to do CC, BCC
5) How to specify SMTP server
6) How to specify SMTP server port other than 25

Click here to copy the following block

Private Sub SendEmailTest()
  SendMail("toemail@binaryworld.net", _
   "fromemail@binaryworld.net", _
   "someCCemail@binaryworld.net", _
   "", _
   "Test HTML <B>Email</B>", _
   "Test email", _
   True, _
   "fromemail@binaryworld.net", _
   "DHANA", _
   25, _
   True, _
   "c:\clip.txt;c:\authors.txt")
End Sub

Private Sub SendMail(ByVal EmailTo As String, _
  ByVal EmailFrom As String, _
  Optional ByVal EmailCC As String = "", _
  Optional ByVal EmailBCC As String = "", _
  Optional ByVal EmailBody As String = "", _
  Optional ByVal EmailSubject As String = "", _
  Optional ByVal EmailWithReceipt As Boolean = False, _
  Optional ByVal EmailReceipTo As String = "", _
  Optional ByVal SMTPServer As String = "", _
  Optional ByVal SMTPPort As Integer = 25, _
  Optional ByVal IsBodyHTML As Boolean = True, _
  Optional ByVal AttachFileList As String = "")

  On Error GoTo errHandler

  Dim colAttachFiles() As String '//lile list
  Dim cdoConfig, cdoMessage As Object

  Const cdoSMTPServerPort = "http://schemas.microsoft.com/cdo/configuration/smtpserverport"
  Const cdoDispositionNotificationTo = "urn:schemas:mailheader:disposition-notification-to"
  Const cdoReturnReceiptTo = "urn:schemas:mailheader:return-receipt-to"
  Const cdoSMTPServer = "http://schemas.microsoft.com/cdo/configuration/smtpserver"
  Const cdoSendUsingMethod = "http://schemas.microsoft.com/cdo/configuration/sendusing"

  'since this doesn't *have* to match the from address

  cdoConfig = CreateObject("CDO.Configuration")
  cdoMessage = CreateObject("CDO.Message")

  With cdoConfig.Fields
    .Item(cdoSendUsingMethod) = 2      'cdoSendUsingPort
    .Item(cdoSMTPServer) = SMTPServer
    .Item(cdoSMTPServerPort) = SMTPPort
    .Update()
  End With

  With cdoMessage
    '//This will be used to request sent receipt
    If EmailWithReceipt = True Then
      .Fields(cdoDispositionNotificationTo) = IIf(EmailReceipTo = "", EmailFrom, EmailReceipTo)
      .Fields(cdoReturnReceiptTo) = IIf(EmailReceipTo = "", EmailFrom, EmailReceipTo)
      .Fields.Update()
    End If
    .Configuration = cdoConfig

    .From = EmailFrom
    .To = EmailTo
    If EmailCC <> "" Then .CC = EmailCC
    If EmailBCC <> "" Then .BCC = EmailBCC
    .subject = EmailSubject

    If IsBodyHTML = True Then
      '//HTML Body
      '//.HTMLBody = "<U>This is a test for CDO.message</U>"
      .HTMLBody = EmailBody
    Else
      .TextBody = EmailBody
    End If

    Dim i As Integer
    '//process attachments
    If AttachFileList <> "" Then
      colAttachFiles = Split(Trim(AttachFileList), ";")

      For i = 0 To UBound(colAttachFiles)
        .AddAttachment(colAttachFiles(i))
      Next
    End If
    .Send()
  End With

  cdoMessage = Nothing
  cdoConfig = Nothing
  Exit Sub
errHandler:
  Err.Raise(Err.Number, Err.Description)
End Sub