Использование CDO/SMTP/TLS в VB6 для отправки электронной почты почтовый сервер smtp.office365.com

С помощью этого кода я могу отправлять почту с помощью CDO в Office365.

    Private Message As CDO.Message
Private Attachment, Expression, Matches, FilenameMatch, i

Sub enviar_mail()

Set Message = New CDO.Message
Message.Subject = "Test Mail"
Message.From = "[email protected]"
Message.To = ""
Message.CC = ""
Message.TextBody = "my text body here"

Dim Configuration
Set Configuration = CreateObject("CDO.Configuration")
Configuration.Load -1 ' CDO Source Defaults
Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.office365.com"
Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "[email protected]"
Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "YourPass"
Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True

Configuration.Fields.Update

Set Message.Configuration = Configuration
Message.Send

Конец сабвуфера

Этот код работал у меня до тех пор, пока несколько дней назад мы не сменили провайдера (или, может быть, что-то случайно изменилось на стороне сервера). Если я укажу порт 587, я получаю транспортную ошибку и не нашел решения для этого с помощью VBA. Пожалуйста, дайте мне знать, если это работает для вас, и если вы найдете способ использовать 587. (У меня тоже не работает порт 25, та же ошибка.)

Public Function SMTPSend(vSendTo, vsubject As Variant, vmessage As Variant)
'This works
Set emailObj = CreateObject("CDO.Message")

emailObj.From = "[email protected]"
emailObj.To = vSendTo
emailObj.Subject = vsubject
emailObj.TextBody = vmessage
'emailObj.AddAttachment "c:\windows\win.ini"

Set emailConfig = emailObj.configuration


emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.office365.com"
'Must exclude port if specifying SSL
'emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 587
emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/sendusername") = "[email protected]"
emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "mypassword"
emailConfig.Fields.Update

emailObj.Send

If Err.Number = 0 Then SMTPSend = True Else SMTPSend = False

End Function

Кажется, на различных форумах есть сообщения о том, что библиотека CDO не работает с портом 587, но это не так. Я думаю, что реальная проблема заключается в том, что службы SMTP, использующие порт 587, делают это, потому что им требуется STARTTLS аутентификация, а параметр конфигурации http://schemas.microsoft.com/cdo/configuration/smtpusessl специфичен для SSL, а не TLS (я знаю, я знаю - не самое точное описание, но это' пока хватит).

Вместо этого есть другой параметр — http://schemas.microsoft.com/cdo/configuration/sendtls — который поддерживает TLS, поэтому его использование с портом 587 работает нормально:

config.Fields("http://schemas.microsoft.com/cdo/configuration/sendusing").Value = 2          '2 = cdoSendUsingPort
config.Fields("http://schemas.microsoft.com/cdo/configuration/smtpserver").Value = "smtp.example.com"
config.Fields("http://schemas.microsoft.com/cdo/configuration/smtpserverport").Value = 587
config.Fields("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate").Value = 1   '1 = cdoBasic
config.Fields("http://schemas.microsoft.com/cdo/configuration/sendusername").Value = "my_username"
config.Fields("http://schemas.microsoft.com/cdo/configuration/sendpassword").Value = "myy_very_secret_password"
config.Fields("http://schemas.microsoft.com/cdo/configuration/sendtls").Value = True
config.Fields("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout").Value = 60
config.Fields.Update()

Не знаю, сможете ли вы это исправить, но у меня получилось вот так:

Private Sub Command1_Click()

Dim oSmtp As New EASendMailObjLib.Mail
oSmtp.LicenseCode = "TryIt"

' Set your Hotmail email address
oSmtp.FromAddr = "[email protected]"

' Add recipient email address
oSmtp.AddRecipientEx "[email protected]", 0

' Set email subject
oSmtp.Subject = "test email from hotmail account"

' Set email body
oSmtp.BodyText = "this is a test email sent from VB 6.0 project with hotmail"

' Hotmail SMTP server address
oSmtp.ServerAddr = "smtp.live.com"

' Hotmail user authentication should use your 
' Hotmail email address as the user name. 
oSmtp.UserName = "[email protected]"
oSmtp.Password = "yourpassword"

' Set port to 25, if you want to use 587 port, please change 25 to 587
oSmtp.ServerPort = 25

' detect SSL/TLS connection automatically
oSmtp.SSL_init

MsgBox "start to send email ..."

If oSmtp.SendMail() = 0 Then
    MsgBox "email was sent successfully!"
Else
    MsgBox "failed to send email with the following error:" & oSmtp.GetLastErrDescription()
End If

Конец сабвуфера

Шрифт: https://www.emailarchitect.net/easendmail/kb/vb.aspx?cat=4

Не забудьте скачать библиотеку:

http://easendmail-smtp-component-net-edition.soft112.com/