Sub send_email()

' Check if Mail was sent (value = 1) if so, do nothing
If Range("B5").Value = 1 Then Exit Sub

Dim NewMail As Object
Dim MailConfig As Object
Dim SMTP_Config As Variant
Dim strSubject As String
Dim strFrom As String
Dim strTo As String
Dim strCc As String
Dim strBcc As String
Dim strBody As String


strSubject = "Mail from Excel"
strFrom = "[ENTER YOU FROM ADDRESS]"
strTo = Range("B1").Value ' set directly "[ENTER YOUR TO ADDRESS]"
strCc = ""
strBcc = ""
strBody = "Hallo " & Range("B2").Value & " " & Range("B4").Value & ". Heute ist der " & Range("B3")


Set NewMail = CreateObject("CDO.Message")
Set MailConfig = CreateObject("CDO.Configuration")

MailConfig.Load -1

Set Fields = MailConfig.Fields

    msConfigURL = "http://schemas.microsoft.com/cdo/configuration"

    With Fields
        'Enable SSL Authentication
        .Item(msConfigURL & "/smtpusessl") = True

        'Make SMTP authentication Enabled=true (1)
        .Item(msConfigURL & "/smtpauthenticate") = 1

        'Set the SMTP server and port Details
        'To get these details you can get on Settings Page of your Gmail Account
        .Item(msConfigURL & "/smtpserver") = "smtp.gmail.com"
        .Item(msConfigURL & "/smtpserverport") = 465
        .Item(msConfigURL & "/sendusing") = 2

        'Set your credentials of your Gmail Account
        .Item(msConfigURL & "/sendusername") = "[ENTER YOU FROM ADDRESS]"
        .Item(msConfigURL & "/sendpassword") = "[ENTER YOU FROM PASSWORD]"

        'Update the configuration fields
        .Update

    End With
    NewMail.Configuration = MailConfig
    NewMail.Subject = strSubject
    NewMail.From = strFrom
    NewMail.To = strTo
    NewMail.TextBody = strBody
    NewMail.CC = strCc
    NewMail.BCC = strBcc
    NewMail.Send
    ' Change Cell Value to indicate Mail was sent
    Range("B5").Value = 1
    ' MsgBox ("Mail sent")

Exit_Err:

    Set NewMail = Nothing
    Set MailConfig = Nothing
    End

Err:
    Select Case Err.Number

    Case -2147220973  'Could be because of Internet Connection
        MsgBox " Could be no Internet Connection !!  -- " & Err.Description

    Case -2147220975  'Incorrect credentials User ID or password
        MsgBox "Incorrect Credentials !!  -- " & Err.Description

    Case Else   'Rest other errors
        MsgBox "Error occured while sending the email !!  -- " & Err.Description
    End Select

    Resume Exit_Err

With NewMail
 Set .Configuration = MailConfig
End With


Error_Handling:
If Err.Description <> "" Then MsgBox Err.Description

End Sub