' Sends email from VBA in Excel, also works on VB6, Classic ASP and most other VB platfolrm
' You need to set the variables:
' AdminEmail
' AdminPassword
' MailServer
' That email account have to be existed with SMTP server

Sub SendMail(sFrom, sTo, sCC, sSubject, sBody)
Const MailServer = "smtp.server.com"
Const MailPort = 25
Const MailUsing = 2
Const MailBasic = 1 'basic (clear-text) authentication
Const AdminEmail = "Email!Address.com"
Const AdminPassword = "Password1"

Set mymail = CreateObject("CDO.Message")
mymail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = MailUsing
'Name or IP of remote SMTP server
mymail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = MailServer
'Server port
mymail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = MailPort
'Type of authentication, NONE, Basic (Base64 encoded), NTLM
mymail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = MailBasic
'Your UserID on the SMTP server
mymail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = AdminEmail
'Your password on the SMTP server
mymail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = AdminPassword
'Server port (typically 25)
mymail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
'Use SSL for the connection (False or True)
mymail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = False
'Connection Timeout in seconds (the maximum time CDO will try to establish a connection to the SMTP server)
mymail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 10
mymail.Configuration.Fields.Update

mymail.Subject = sSubject
mymail.From = sFrom
mymail.To = sTo
mymail.cc = sCC
mymail.BodyPart.Charset = "utf-8"
mymail.HTMLBody = sBody
mymail.HTMLBodyPart.Charset = "windows-1256"
mymail.HTMLBodyPart.ContentTransferEncoding = "binary"
On Error Resume Next
mymail.send
If Err.Number <> 0 Then
MsgBox "Error sending" & vbCrLf & Err.Number & " : " & Err.Description, vbCritical
Else
'MsgBox " Sent ok", vbInformation
End If
Set mymail = Nothing

End Sub