CDO Emails

[Fire_Chief]

I have used this code many times and it worked great. This year it stopped.

I am using the lastest edition of Excel.

I get this error
---------------------------------------
Run-time error '-2147220975 (80040211)':

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


My ISP is comcast but it also worked for g-mail and yahoo.

I also have code to send emails with Outlook and that still works fine. However a friend also
uses this and he does not use Outlook so he has been using the code below.

I know there is a "less secure" option on the comcast, g-mail and yahoo sites to let third party applications work and I did check that box.

I have spent hours trying to get it to work, so any help would be GREATLY appreciated

Below is the code that suddenly stopped working.

I think it will take someone MUCH better at code than I am to find why it doesn't work.

Thank you so much if you can help.

Marty


Sub SEND_PDF_SHEET_WITH_CDO()

Dim filepath As String

filepath = Environ$("temp") & "\" & ActiveWorkbook.Name & ".pdf" 'TODO:change filepath for the temp pdf file

On Error GoTo ErrHandler:

Range("A5:P39").Select 'This is the section of a page in excel I want to send

Selection.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
filepath, _
Quality:=xlQualityStandard, IncludeDocProperties:=False, IgnorePrintAreas _
:=False, OpenAfterPublish:=False
'Setting up CDOSYS configuration to send out the email
Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")
Set Flds = iConf.Fields
With Flds
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
.Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusetls") = True
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = True
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "D1C@comcast.net" 'Needs to be changed.
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "email password goes here" 'Needs to be changed.
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.comcast.net" 'Needs to be changed if not comcast
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = "465"
.Update
End With

With iMsg
Set .Configuration = iConf
.From = "D1C@comcast.net" 'Needs to be changed.
.To = "D1C@comcast.net" 'Needs to be changed.
.Subject = "IMPORTANT"
.HTMLBody = ""
.AddAttachment (filepath) 'This would be the range of your sheet being sent...Range("A5:P39").Select
.Send
End With

Set iMsg = Nothing
Set iConf = Nothing
Kill filepath

MsgBox "YOUR EMAIL WAS SENT"
Exit Sub

ErrHandler:

If Err.Description <> "" Then MsgBox (Err.Description & vbCrLf & Err.Number)

End Sub

 

[Fire_Chief]

I found the mistake.
I was puting in the password wrong... It need a symbol at the end and I didn't enter it.