Option Explicit

'****************************************************************************
'****************************************************************************
'***                                                                      ***
'***                  ~~~     CDO SEND EMAIL     ~~~                      ***
'***                                                                      ***
'***           Ref: Microsoft CDO for Exchange 2000 library               ***
'***                                                                      ***
'****************************************************************************
'****************************************************************************

Const SMTP_SERVER   As String = "smtp.myserver.com"
Const SMTP_PORT     As Long = 25
Const MAIL_SUBJECT  As String = "Test Message"
Const MAIL_MESSAGE  As String = "This is my message"
Const MAIL_FROM     As String = "me@my.com"
Const MAIL_TO       As String = "you@yours.com"

Private objMessage As CDO.Message

Private Sub Command1_Click()
    Call cdoBasic
End Sub
Private Sub Command2_Click()
    Call cdoAttach
End Sub
Private Sub Command3_Click()
    Call cdoHTML
End Sub
Private Sub Command4_Click()
    Call cdoBCC
End Sub

'// CDO BASIC EMAIL
Private Sub cdoBasic()

On Error GoTo err:

    Command1.Enabled = False
    Command2.Enabled = False
    Command3.Enabled = False
    Command4.Enabled = False
    
    Set objMessage = New CDO.Message
    objMessage.Subject = MAIL_SUBJECT
    objMessage.From = MAIL_FROM
    objMessage.To = MAIL_TO
    objMessage.TextBody = MAIL_MESSAGE
    
    objMessage.Configuration.Fields.Item _
    ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
    objMessage.Configuration.Fields.Item _
    ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = SMTP_SERVER
    objMessage.Configuration.Fields.Item _
    ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = SMTP_PORT
    objMessage.Configuration.Fields.Update
    objMessage.Send
    Set objMessage = Nothing
    
    MsgBox "Email Sent!"
    Command1.Enabled = True
    Command2.Enabled = True
    Command3.Enabled = True
    Command4.Enabled = True
        Exit Sub
err:
    Command1.Enabled = True
    Command2.Enabled = True
    Command3.Enabled = True
    Command4.Enabled = True
    MsgBox "Mail Error!" & vbNewLine & err.Description
        Exit Sub
End Sub

'// CDO WITH ATTACHEMENT
Private Sub cdoAttach()

On Error GoTo err:

    Command1.Enabled = False
    Command2.Enabled = False
    Command3.Enabled = False
    Command4.Enabled = False
    
    Set objMessage = New CDO.Message
    objMessage.Subject = MAIL_SUBJECT
    objMessage.From = MAIL_FROM
    objMessage.To = MAIL_TO
    objMessage.TextBody = MAIL_MESSAGE
    
    '// ATTACH FILE
    objMessage.AddAttachment App.Path & "\text.txt"
    
    objMessage.Configuration.Fields.Item _
    ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
    objMessage.Configuration.Fields.Item _
    ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = SMTP_SERVER
    objMessage.Configuration.Fields.Item _
    ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = SMTP_PORT
    objMessage.Configuration.Fields.Update
    objMessage.Send
    Set objMessage = Nothing
    
    MsgBox "Email Sent!"
    Command1.Enabled = True
    Command2.Enabled = True
    Command3.Enabled = True
    Command4.Enabled = True
        Exit Sub
err:
    Command1.Enabled = True
    Command2.Enabled = True
    Command3.Enabled = True
    Command4.Enabled = True
    MsgBox "Mail Error!" & vbNewLine & err.Description
        Exit Sub
End Sub

'// CDO WITH HTML BODY
Private Sub cdoHTML()

On Error GoTo err:

    Command1.Enabled = False
    Command2.Enabled = False
    Command3.Enabled = False
    Command4.Enabled = False
    
    Set objMessage = New CDO.Message
    objMessage.Subject = MAIL_SUBJECT
    objMessage.From = MAIL_FROM
    objMessage.To = MAIL_TO
    
    '// ADD HTML
    'objMessage.HTMLBody = "<h1>HTML TEST</h1><i>" & MAIL_MESSAGE & "</i>"
    
    '// ADD WEB PAGE
    objMessage.CreateMHTMLBody "http://www.knowlesrealty.com/index.html"
    
    objMessage.Configuration.Fields.Item _
    ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
    objMessage.Configuration.Fields.Item _
    ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = SMTP_SERVER
    objMessage.Configuration.Fields.Item _
    ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = SMTP_PORT
    objMessage.Configuration.Fields.Update
    objMessage.Send
    Set objMessage = Nothing
    
    MsgBox "Email Sent!"
    Command1.Enabled = True
    Command2.Enabled = True
    Command3.Enabled = True
    Command4.Enabled = True
        Exit Sub
err:
    Command1.Enabled = True
    Command2.Enabled = True
    Command3.Enabled = True
    Command4.Enabled = True
    MsgBox "Mail Error!" & vbNewLine & err.Description
        Exit Sub
End Sub

'// CDO WITH BCC & CCC
Private Sub cdoBCC()

On Error GoTo err:

    Command1.Enabled = False
    Command2.Enabled = False
    Command3.Enabled = False
    Command4.Enabled = False
    
    Set objMessage = New CDO.Message
    objMessage.Subject = MAIL_SUBJECT
    objMessage.From = MAIL_FROM
    objMessage.To = MAIL_TO
    objMessage.TextBody = MAIL_MESSAGE
    
    '// BCC & CCC
    objMessage.BCC = MAIL_FROM
    objMessage.CC = MAIL_FROM
    
    objMessage.Configuration.Fields.Item _
    ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
    objMessage.Configuration.Fields.Item _
    ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = SMTP_SERVER
    objMessage.Configuration.Fields.Item _
    ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = SMTP_PORT
    objMessage.Configuration.Fields.Update
    objMessage.Send
    Set objMessage = Nothing
    
    MsgBox "Email Sent!"
    Command1.Enabled = True
    Command2.Enabled = True
    Command3.Enabled = True
    Command4.Enabled = True
        Exit Sub
err:
    Command1.Enabled = True
    Command2.Enabled = True
    Command3.Enabled = True
    Command4.Enabled = True
    MsgBox "Mail Error!" & vbNewLine & err.Description
        Exit Sub
End Sub