Send CDO emails from any client/server with Excel

2

I'm trying to set up an .xlsm workbook to send emails to different email addresses with specific data from the spreadsheet.

I want that it doesn't matter what email client or server is used.

I'm currently trying to get it working for hotmail.

Here's my code:

Sub Button1_Click()
    Dim CDO_Mail As Object
    Dim CDO_Config As Object
    Dim SMTP_Config As Variant
    Dim strSubject As String
    Dim strFrom As String
    Dim strTo As String
    Dim strCc As String
    Dim strBcc As String
    Dim strBody As String
    
    strSubject = "SUBJECT"
    strFrom = "******@hotmail.com"
    strTo = "************@hotmail.com"
    strCc = ""
    strBcc = ""
    strBody = "BODY TEXT HERE"
    
    Set CDO_Mail = CreateObject("CDO.Message")

    Set CDO_Config = CreateObject("CDO.Configuration")
    CDO_Config.Load -1

    Set SMTP_Config = CDO_Config.Fields

    With SMTP_Config
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.live.com"
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "******@hotmail.com"
        .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "password"
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
        .Update
    End With

    With CDO_Mail
        Set .Configuration = CDO_Config
    End With

    CDO_Mail.Subject = strSubject
    CDO_Mail.From = strFrom
    CDO_Mail.To = strTo
    CDO_Mail.TextBody = strBody
    CDO_Mail.CC = strCc
    CDO_Mail.BCC = strBcc
    CDO_Mail.Send

    MsgBox ("Emails have been sent.")
End Sub

I get the following error:

Run-time error '-2147220975 (80040211)'

The message could not be sent to the SMTP server, The transport error code was 0x80040217. The server response was not available.

I've also tried changing the port from 25 to 587 and I get the error:

The transport failed to connect to the server.

I also initially didn't have the 2 following lines in there:

.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True

And when they weren't there I got the error:

The server rejected the sender address. The server response was: 530 5.7.0 Must issue a STARTTLS command first.

vba
excel
email
smtp
asked on Stack Overflow Mar 20, 2017 by user3636407 • edited Jun 20, 2020 by Community

0 Answers

Nobody has answered this question yet.


User contributions licensed under CC BY-SA 3.0