En vba enviando correo pone error de transporte en la conexión al servidor

La macro funcionaba, ya lo intente de diferentes ordenadores, no le he movido nada...

La macro guarda una copia y envía la copia vía gmail

Anexo el código

Sub Sendmail()
'Guarda una copia
Application.DisplayAlerts = False
Application.ScreenUpdating = False

Cells.Select
Selection.Copy
Workbooks.Add
ActiveSheet.Paste
Application.CutCopyMode = False
ChDir "C:\sysal\"
ActiveWorkbook.SaveAs Filename:="C:\sysal\edocta.xls", FileFormat:=xlNormal, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False
ActiveWorkbook.Close

'Envia la copia
Dim NewMail As CDO.Message, sentencia As String

Set NewMail = New CDO.Message
sentencia = "Estado de cuenta " & Range("A11")

'Enable SSL Authentication
NewMail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True

NewMail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1

'Poner servidor SMTP y puerto

NewMail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"

NewMail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25

NewMail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2

NewMail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusername") = "[email protected]"

NewMail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "xxx"

NewMail.Configuration.Fields.Update

With NewMail
.Subject = "estado de cta allure"
.From = "[email protected]"
.To = Range("Mail")
.CC = "[email protected]"
.BCC = ""
.TextBody = sentencia
.AddAttachment "C:\sysal\edocta.xls"
End With

Application.DisplayAlerts = True
Application.ScreenUpdating = True

NewMail.Send
MsgBox ("Email a sido enviado")

Set NewMail = Nothing

End Sub

Añade tu respuesta

Haz clic para o