Наши проекты:
Журнал · Discuz!ML · Wiki · DRKB · Помощь проекту |
||
ПРАВИЛА | FAQ | Помощь | Поиск | Участники | Календарь | Избранное | RSS |
[54.224.52.210] |
|
Сообщ.
#1
,
|
|
|
Здравствуйте!
Есть чудесная программа по отправке писем. Но при попытке отправить с сервера mail.ru выдаёт, что нужно только SSL or TLS соединение. Подскажите, пожалуйста, можно ли как-то исправить ситуацию? Возможно, это не только мне пригодится Прикреплённый файлvbSendMail.rar (198,79 Кбайт, скачиваний: 133) |
Сообщ.
#2
,
|
|
|
помогли на другом форуме, работает!
Option Explicit Private Sub Form_Load() Dim txt$ SaveAccountData txt = "Это письмо сформировано макросом" & vbNewLine & "без использования внешних программ и подключения дополнительных библиотек" If Send_Mail("FelixMacintosh@yandex.ru", "FelixMacintosh@yandex.ru", "проверка отправки почты_2", _ txt) Then MsgBox "Письмо успешно отправлено", vbInformation Else MsgBox "Не удалось отправить письмо", vbExclamation End If End Sub Function Send_Mail(ByVal MailTo 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/" Dim smtpserver$, sendusername$, sendpassword$ Dim cdoConfig As Object, cdoMessage As Object On Error Resume Next: Err.Clear 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 'для отправки почты с аккаунта @gmail.com .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: .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 |