Macro envió correos por Gmail con otro dominio

¿Tienes ese correo configurado en tu "Microsoft Outlook"? De ser no la respuesta, podrías usar CDO pero necesitas tener los parámetros SMTP, y otros, de dicho correo personal.

¿Cuál sería tu caso?

Abraham Valencia

Gracias por la colaboración y tan pronta respuesta, mi caso es como dices de no por Outlook, es por navegador de Internet intente utilizar un código que vi en un tema resuelto pero no me funciono, no se si sea por lo que mencionas de tener los parámetros SMTP que realmente me disculpo por la ignorancia no se que son.

Sub SendMail_Gmail()
'Mod.Por.DAM
Dim Email As CDO.Message
correo = "[email protected]"
passwd = "pwd"
For i = 2 To Range("A" & Rows.Count).End(xlUp).Row
    Set Email = New CDO.Message
    Email.Configuration.Fields(cdoSMTPServer) = "smtp.gmail.com"
    Email.Configuration.Fields(cdoSendUsingMethod) = 2
    With Email.Configuration.Fields
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = CLng(465)
        .Item("http://schemas.microsoft.com/cdo/" & "configuration/smtpauthenticate") = Abs(1)
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 30
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = correo
        .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = passwd
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
    End With
    With Email
        .To = Cells(i, "A")
        .From = correo
        .Subject = Cells(i, "B")
        .TextBody = Cells(i, "C")
        .AddAttachment Cells(i, "E") & Cells(i, "D")
        .Configuration.Fields.Update
        On Error Resume Next
        .Send
    End With
    If Err.Number = 0 Then
        Cells(i, "F") = "El mail se envió con éxito"
    Else
        Cells(i, "F") = "Se produjo el siguiente error: " & Err.Number & " " & Err.Description
    End If
    Set Email = Nothing
Next
End Sub

Cuando se usa CDO, algunos parámetros varían dependiendo del servidor de correo, por ejemplo lo que tú has enviado es para "gmail", tú tienes que saber/obtener el SMTP de tu servidor de correo para reemplazar el de ahí ("smtp.gmail.com") y además probar/saber el puerto adecuado (ahí usan el 465) ¿Tienes y/o puedes conseguir dichos parámetros? Lo más importante es el SMTP.

Abraham Valencia

realmente no se, pero si me puedes orientar intentare y estaré muy agradecido por tu colaboración 

Quizá en la página web de tu correo esté ¿cuál es el dominio de dicho correo que quieres usar?

Abraham Valencia

El link es el siguiente no se si sea útil https://mail.google.com/mail/u/0/#inbox, el dominio es de la empresa donde trabajo @Planeta.com, o me indicas donde lo puedo obtener que pena y gracias por la colaboración

Al parecer tu dominio usa servidores de Google así que intenta así (macro de Ron de Bruin), solo reemplazando tu clave, tu correo (dos veces, mira bien) y el correo de destino (alguno al que tengas acceso para saber si la prueba fue satisfactoria):

Sub CDO_Mail_Small_Text_2()
    Dim iMsg As Object
    Dim iConf As Object
    Dim strbody As String
    Dim Flds As Variant
    Set iMsg = CreateObject("CDO.Message")
    Set iConf = CreateObject("CDO.Configuration")
    iConf.Load -1
    Set Flds = iConf.Fields
    With Flds
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "[email protected]"
        .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "TuClave"
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
        .Update
    End With
    strbody = "Esto es una prueba"
    With iMsg
        Set .Configuration = iConf
        .To = "[email protected]"
        .CC = ""
        .BCC = ""
        .From = "[email protected]"
        .Subject = "Prueba"
        .TextBody = strbody
        .Send
    End With
End Sub

Una vez que la prueba sea exitosa, ya sabemos que puedes usar CDO desde el correo en cuestión.

Abraham Valencia

Muchas gracias por tu colaboración, la macro parece funcionar o por lo menos ejecutar, pero al finalizar sale el siguiente error.

Que pena tanta molestia muchas gracias 

No te preocupes, no hay problema.

Cambia el puerto, yo puse el 25, coloca 465. Adicional a eso (por si acaso), en las referencias de VBA activa la que dice "Microsoft CDO for Windows 2000 Library".

Comentas

Abraham Valencia

sigue sin funcionar valide las referencias y estas son las que están activas 

con el siguiente error. 

¿Qué línea es la que se sombrea de amarillo?

Abraham Valencia

Por cierto ¿usas de anti virus McAffee o Norton? Si tu correo y clave están correctas, intenta ahora con el puerto 587

Abraham Valencia

La macro ejecuta no sale ninguna línea amarilla, pero sigue saliendo el mismo error el antivirus es McAffe gracias

McAffee y Norton tienden a cerrar los puertos e impedir ese tipo de envíos. Prueba desactivando el antivirus y probando, uno por uno, los puertos sugeridos.

Abraham Valencia

si ese el tema realmente no tengo como hacer lo que me sugieres por que no tengo permisos ya que esta bloqueado desde el área de sistemas, pero entonces igual forma agradezco la colaboración y dedicación, creo que no sera posible realizar la macro para el fin necesario. 

pero fue de mucha ayuda para aprender algo mas agradezco la paciencia.