VBA, MS Access MS Access в примерах

Отправка E-Mail через CDO.Message

Public Function SendEmail()
'Отправка почты через CDO.Message (тут на smtp.yandex.ru)
'--------------------------------------------------------------------------
'Доп инфо: http://www.askit.ru/custom/vba_office/m13/13_08_cdo_vba.htm
'--------------------------------------------------------------------------
Dim msg As Object
Dim sConfig As String

On Error GoTo SendEmail_Err

    Set msg = CreateObject("CDO.Message")

    msg.BodyPart.Charset = "windows-1251"
    sConfig = "http://schemas.microsoft.com/cdo/configuration/"
    With msg
        .To = "Имя_Пользователя@yandex.ru"
        .From = "Имя_Пользователя@yandex.ru"
        .Subject = "Тут тема сообщения ..."  'тема сообщения
        .TextBody = "Бла Бла Бла, провнрка связи"    'Cодержание сообщения
        With .Configuration.Fields
            .Item(sConfig & "sendusing") = 2 
            .Item(sConfig & "smtpserver") = "smtp.yandex.ru" 'SMTP Сервер
            .Item(sConfig & "smtpauthenticate") = 1  'SMTP Требует аутификацию = 1 (нет = 0)
            .Item(sConfig & "smtpserverport") = 465  'SMTP Порт номер
            .Item(sConfig & "smtpusessl") = True     'SMTP Использовать SSL
            .Item(sConfig & "sendusername") = "Имя_Пользователя@yandex.ru" 'Адрес отправителя
            .Item(sConfig & "sendpassword") = "XXXXXX"    'Пароль электронного ящика отправителя
            .Item(sConfig & "smtpconnectiontimeout") = 30 'Сколько ждать ответа сервера в секундах
            .Update
        End With
        .send 'Собственно отправка сабжа ...
    End With
     

SendEmail_End:
    On Error Resume Next
    Set msg = Nothing
    Exit Function

SendEmail_Err:
    MsgBox "Error: " & Err.Number & vbCrLf & Err.Description & vbCrLf & _
    "in Function: SendEmail in module: mod00Test", vbCritical, "Error in Application"
    Err.Clear
    Resume SendEmail_End
End Function
Назад ToTop
L.E. 17.10.2018
Рейтинг@Mail.ru