Enviar Email por el excel vba
He puesto todos los metodos conocidos para enviar email ppor excel pero ninguna funciona, ya que gmail no acepta correos de lugares no confiables, es por ello, que modifique una macro de un amigo, pero no me funciona. Haber si me pueden ayudar, adjunto la macro.
Sub Emails() Hoja5.Visible = xlSheetVisible Hoja5.Activate ActiveSheet.Copy With ActiveWorkbook .SendMail Recipients:="[email protected]", Subject:="Informe diario Acopio" .Close savechanges:=False End With Hoja1.Activate MsgBox "Se envio el email" End Sub
1 Respuesta
Respuesta de Cpc Julio Pinedo Reategui
1
He solucionado el inconveniente con la siguiente macro:
Sub Enviar_gmail()
' Macro modificado por J.P
Application.ScreenUpdating = False
Dim hoja As Sheets
Dim NewMail As CDO.Message
Dim a, b As String
Dim archivo As Variant
Set NewMail = New CDO.Message
Application.DisplayAlerts = False
' ADJUNTAREMOS LA HOJA GUARDADA EN EL DIA
a = Format(Hoja1.Range("C4"), "DD")
b = Format(Hoja1.Range("C4"), "MMMM")
archivo = "G:\Programa\Archivos\Informe del " & a & " de " & b & ".xlsx"
NewMail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
NewMail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
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") = "xxxxxx"
NewMail.Configuration.Fields.Update
With NewMail
.Subject = "Informe Diario de Acopio"
.From = "[email protected]"
.To = "[email protected]"
.CC = ""
.BCC = ""
.AddAttachment archivo
.TextBody = "Estimad@ " & Chr(13) _
& " Se envia el informe del dia " & Hoja1.Range("C4") & Chr(13) & Chr(13) & "Atentamente: " & Chr(13) & " Sr. xxx"
End With
NewMail.Send
MsgBox ("El Informe fue enviado via Email")
Set NewMail = Nothing
End SubY para que funcione, tuve que desactivar la casilla en esta direccion:
https://www.google.com/settings/security/lesssecureapps
Espero les ayude a algunos que desean enviar email por Gmail y tienen el inconveniente de "no se pudo conectar con el servidor SMTP"
