Hola, desde hace mucho, mucho tiempo uso el código que se publicó, en el foro para enviar mails a traves de gmail como smtp externo y funcionaba a las mil maravillas.
Se ha actualizado la política de google así:
Aplicaciones menos seguras y la cuenta de GooglePara proteger tu cuenta, a partir del
30 de mayo del 2022, Google dejará de admitir aplicaciones y dispositivos de terceros que te pidan que inicies sesión en tu cuenta de Google usando solo tu nombre de usuario y contraseña.
Importante: Este plazo no se aplica a los clientes de Google Workspace o de Google Cloud Identity. La fecha en que el cambio se implementará para estos clientes se anunciará en el blog de Workspace más adelante.
Para obtener más información, sigue leyendo.
Y desde ese momento no funciona mi rutina para enviar pedidos que iba tan bien. He cambiado servidor, puerto, Encrypt, etc y no lo consigo.
Como veréis arrastro el problema desde mayo, no es que no lo haya probado. Incluso lo he intentado con un servicio propio de mi dominio y no consigo que se envie nada. Me da error de Conexion failed y otro de EHLO.
¿Que hay que cambiar para seguir usándolo? o es gb.net.smtp que ha dejado de funcionar (cosa que dudo)
Me da igual usar una cuenta de mi dominio si con gmail ya no se puede hacer... pero como lo arreglo o configuro?
Gracias
El código es:
Código:
Public Sub enviarmail(aTo As String[], cAsunto As String, cTexto As String, Optional cFrom As String, Optional bcc As String[], Optional adjuntos As Variant[])
Dim hfile As File
Dim archivo As String
Dim destinatarios As String
Dim textoplano As String
Dim destino As String
Dim enviador As New SmtpClient
Dim campos As New String[]
Application.busy = 1
enviador.host = usu.mihost '"miservidor de correo"
enviador.user = usu.miusuariodecorreo ' "miusuariodecorreo"
enviador.password = usu.miclavedeusuariodecorreo ' "miclavedeusuariodecorreo"
enviador.Encrypt = Net.SSL
If Not cFrom Then cFrom = usu.micuentacorreo ' "micuenta@remitentedecorreo"
enviador.Alternative = True
enviador.Port = 465
enviador.From = cFrom
For Each destino In aTo
enviador.to.Add(destino)
Next
enviador.Subject = cAsunto
' enviador.Add(cTexto, "text/plain")
enviador.Add(cTexto, "text/html")
Try enviador.send
If Error Then
Application.busy = 0
Message.Error("No se ha podido enviar el mensaje\n" & Error.Text)
Return
Endif
Application.busy = 0
Message.Info("Mensaje enviado")
' Como no ha habido error, guardamos los datos de enviado
' para saber que se ha enviado correctamente... (persistencia)
archivo = Settings["DATOS/basedatos"] &/ "correo/enviados.csv"
If Not Exist(archivo) Then
' Aqui puede fallar sin hay mas de 1 nivel de
' directorio sin crear por encima de archivo.
If Not Exist(File.Dir(archivo)) Then
Print "Como no existe creamos " & File.Dir(archivo)
Try Mkdir File.Dir(archivo)
If Error Then Print Error.Text
Endif
campos.Add("fecha")
campos.Add("destinatiarios")
campos.Add("asunto")
campos.Add("desde")
campos.Add("mensaje")
CSVwriter.create(archivo, campos)
Else
CSVwriter.Open(archivo)
Endif
destinatarios = aTo.Join("|")
' Cambio los ; del texto por } y las newline por |
' Al leer habrá que reconstruir
'textoplano = Replace(cTexto, ";", "}")
'textoplano = Replace(textoplano, gb.NewLine, "|")
textoplano = Replace(Replace(ctexto, ";", "}"), gb.newline, "|")
campos.Clear
campos.Add(Format(Date(), "dd/mm/yyyy"))
campos.Add(destinatarios)
campos.Add(cAsunto)
campos.Add(usu.miusuariodecorreo)
campos.Add(textoplano)
CSVwriter.Write(campos)
CSVwriter.Close()
End