Dim o_Mess, v_Conf
v_Conf = "http://schemas.microsoft.com/cdo/configuration/"
Set o_Mess = CreateObject("CDO.Message")
With o_Mess
.To = "support@apple.com" 'куда отправляем
.From = "Alex <xxx@yandex.ru>" 'имя отправителя + Email
.Subject = "Subj" 'Тема письма
.TextBody = "BodyMail" 'Сообщение
.AddAttachment "C:\RemoveDrive.exe" 'Прикрепить файл
.TextBodyPart.Charset = "windows-1251" 'русская кодировка
With .Configuration.Fields
.Item(v_Conf & "sendusing") = 2 'без использования каталога Server Exchange
.Item(v_Conf & "smtpserver") = "smtp.yandex.ru" 'Адрес SMTP-сервера
.Item(v_Conf & "smtpauthenticate") = 1 'Тип авторизации
.Item(v_Conf & "sendusername") = "xxx" 'здесь имя пользователя без @
.Item(v_Conf & "sendpassword") = "pass" 'пароль
.Item(v_Conf & "smtpserverport") = 25 'порт (альтернативный - 465)
.Item(v_Conf & "smtpusessl") = False 'использовать ли шифрованое подключение SSL
.Item(v_Conf & "smtpconnectiontimeout") = 60 'Время до завершения повторных попыток подключения
.Update
End With
.send
End With
Set o_Mess = Nothing

Function Send_Email(Adresat$, AdrHidden$, Subj$, BodyMail$, Attach) As Boolean
On Error GoTo ErrH
Dim att
Dim Jmail

Set Jmail = CreateObject("JMail.Message")
With Jmail
.Charset = "windows-1251" ' кодировка
.AddRecipient Adresat ' адрес получателя
.From = "login@yandex.ru" ' адрес отправителя
.Body = BodyMail ' перевод на новую строку - & vbCrLf
.Subject = Subj ' тема письма
.EnableCharsetTranslation = False ' так надо...
If IsArray(Attach) Then
For Each att In Attach
.AddAttachment att 'Прикрепить файл
Next
End If
.MailServerUserName = "login" ' логин
.MailServerPassword = "pasword" ' пароль
.Send ("smtp.yandex.ru") ' лети!...
End With
Set Jmail = Nothing

Send_Email = (Err = 0)
Err.Clear

'MsgBox "Сообщение отправлено адресатам: " & UBound(Split(AdrHidden, ";")) + 2
Exit Function
ErrH:
Debug.Print Err.Description
Resume Next
End Function