Отправка сообщений на почту - VBA

Формулировка задачи:

Добрый день. Подскажите пожалуйста а как можно отправить сообщение на почту макросом из икселя при определенном условии. Нашел в интернете такой вот код но довести его до работоспособности не могу(

Sub CDO_Mail_Small_Text_2()
Dim iMsg As Object
Dim iConf As Object
Dim strbody As String
Dim Flds As Variant
Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")
iConf.Load -1
Set Flds = iConf.Fields
With Flds
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "Полный адрес вашего GMail ящика"
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "GMail пароль"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465
.Update
End With
strbody = "Поздравляем!!!! Ваше письмо успешно отправлено !!!!"
With iMsg
Set .Configuration = iConf
.To = "Почтовый адрес получателя"
.CC = ""
.BCC = ""
.From = """ВашеИмя"" &lt;removed@mail.ru&gt;"
.Subject = "Попытка отправить письмо с помощью CDO"
.TextBody = strbody
.Send
End With
End Sub

Решение задачи: «Отправка сообщений на почту»

textual
                            Листинг программы 
                        

                            Sub Primer()    ' Пример использования функции Send_Mail
   txt = "Это письмо сформировано макросом" & vbNewLine & _
          "без использования внешних программ и подключения дополнительных библиотек"
    If Send_Mail("mail1@mail.ru", "mail1@mail.ru", "mail3@mail.ru", "mail@mail.ru", "проверка отправки почты", txt) Then
        MsgBox "Письмо успешно отправлено", vbInformation
    Else
        MsgBox "Не удалось отправить письмо", vbExclamation
    End If
End Sub
Private Sub SaveAccountData()    ' запускать один раз - для записи в реестр Windows параметров почтового аккаунта
   SaveSetting Application.Name, "mail", "smtpserver", "smtp.mail.ru"    ' Ваш SMTPServer
   SaveSetting Application.Name, "mail", "sendusername", "mail@mail.ru"    ' Ваша учетная запись
   SaveSetting Application.Name, "mail", "sendpassword", "12345"    ' Ваш  пароль
End Sub
Function Send_Mail(ByVal MailTo As String, ByVal MailCopy As String, ByVal MailCCopy As String, ByVal MailFrom As String, _
                   ByVal MailSubject As String, ByVal MailText As String, _
                   Optional ByVal MailAttachment As String = "") As Boolean
    ' функция для отправки почты без использования внешних почтовых программ
   ' ----------------------------------------------------------------------
   ' в качестве параметров получает:
   ' MailTo - адрес получателя письма
   ' MailFrom - адрес отправителя письма
   ' MailSubject - тема письма
   ' MailText - текст письма
   ' MailAttachment - полный путь к файлу вложения (необязательный параметр)
   ' ----------------------------------------------------------------------
   ' возвращает TRUE, если отправка почты произошла успешно, и FALSE в обратном случае
 
    Const cdoConfigURL = "http://schemas.microsoft.com/cdo/configuration/"
    On Error Resume Next: Err.Clear
 
    SMTPserver = GetSetting(Application.Name, "mail", "smtpserver", "")
    sendusername = GetSetting(Application.Name, "mail", "sendusername", "")
    sendpassword = GetSetting(Application.Name, "mail", "sendpassword", "")
    If Len(SMTPserver) = 0 Or Len(sendusername) = 0 Or Len(sendpassword) = 0 Then Exit Function
 
    Set cdoConfig = CreateObject("CDO.Configuration")
    With cdoConfig.Fields
        .Item(cdoConfigURL & "sendusing") = 2
        .Item(cdoConfigURL & "smtpauthenticate") = 1
        .Item(cdoConfigURL & "smtpserver") = SMTPserver
        .Item(cdoConfigURL & "sendusername") = sendusername
        .Item(cdoConfigURL & "sendpassword") = sendpassword
        .Item(cdoConfigURL & "smtpserverport") = 465 'порт для SSL: 465
        .Item(cdoConfigURL & "smtpusessl") = 1  'использовать аутентификацию: да
        .Update
    End With
 
 
 
 
    Set cdoMessage = CreateObject("CDO.Message")
    With cdoMessage
        Set .Configuration = cdoConfig
        .BodyPart.Charset = "koi8-r"
        .From = MailFrom:
        .cc = MailCopy
        .bcc = MailCCopy
        .To = MailTo
        .Subject = MailSubject
        .TextBody = MailText
        If Len(MailAttachment) > 0 Then .AddAttachment MailAttachment
        .send
    End With
    Set cdoMessage = Nothing: Set cdoConfig = Nothing
 
    '    If Err.Number = -2147220973 Then MsgBox ("Отсутствует связь с интернетом")
   '    If Err.Number = -2147220975 Then MsgBox ("SMTP сервер ответил отказом")
   '    If Err.Number = 0 Then MsgBox ("Письмо отправлено")
   Send_Mail = Err = 0
End Function
                        