Const CDO_Cnf = "http://schemas.microsoft.com/cdo/configuration/"
       Dim oCDOCnf As Object, oCDOMsg As Object
       Dim SMTPserver As String, sUsername As String, sPass As String, sMsg As String
       Dim sTo As String, sFrom As String, sSubject As String, sBody As String, sAttachment As String
       On Error Resume Next
       SMTPserver = "smtp.mail.ru" 'SMTPServer: для Mail.ru "smtp.mail.ru"; для Яндекса "smtp.yandex.ru"; для Рамблера "mail.rambler.ru"
       sUsername = "89028912680@mail.ru" 'учётная запись на сервере
       sPass = "12345" 'пароль к почтовому аккаунту
       If Len(SMTPserver) =  0  Then MsgBox "Не указан SMTP сервер", vbInformation, "Внимание": Exit Sub
       If Len(sUsername) =  0  Then MsgBox "Не указана учётная запись", vbInformation, "Внимание": Exit Sub
       If Len(sPass) =  0  Then MsgBox "Не указан пароль", vbInformation, "Внимание": Exit Sub

       sTo = "angpost@zlt.uvd.chel.su" 'кому
       sFrom = "89028912680@mail.ru" 'от кого
       sSubject = "Автоотправка" 'тема письма
       sBody = "Привет от Excel-VBA" 'текст письма
       'sAttachment = "C:/Temp/Книга1.xls" 'вложение (полный путь к файлу)
       'проверка наличия файла по указанному пути
       'If Dir(sAttachment, vbDirectory) = "" Then sAttachment = ""
       'назначаем конфигурацию CDO
       Set oCDOCnf = CreateObject("CDO.Configuration")
       With oCDOCnf.Fields
              .Item(CDO_Cnf & "sendusing") =  2 
              .Item(CDO_Cnf & "smtpauthenticate") =  1 
              .Item(CDO_Cnf & "smtpserver") = SMTPserver
              .Item(CDO_Cnf & "sendusername") = sUsername
              .Item(CDO_Cnf & "sendpassword") = sPass
              .Update
       End With
       'создаём сообщение
       Set oCDOMsg = CreateObject("CDO.Message")
       With oCDOMsg
              Set .Configuration = oCDOCnf
              .BodyPart.Charset = "koi8-r" 'устанавливаем кодировку страницы письма
              .From = sFrom 'от кого
              .To = sTo 'кому
              .Subject = sSubject 'тема письма
              .TextBody = sBody 'текст письма
              If Len(sAttachment) >  0  Then .AddAttachment sAttachment
              .Send 'отправляем письмо автоматом
       End With

       Select Case Err.Number
       Case - 2147220973 : sMsg = "Нет доступа к Интернет"
       Case - 2147220975 : sMsg = "Отказ сервера SMTP"
       Case  0 : sMsg = "Письмо отправлено"
       End Select
       MsgBox$ sMsg, vbInformation, "Внимание"
       Set oCDOMsg = Nothing: Set oCDOCnf = Nothing