Macro excel para enviar correo con gmail
Tengo este código para enviar un correo desde gmail y necesito ayuda para que me genere un pdf con la página y lo envíe mediante gmail
Sub SendMail_Gmail()
Dim Email As CDO.Message
Set Email = New CDO.Message
correo = "[email protected]"
passwd = "xxxxxxxxx"
destino = "[email protected]"
mensaje = "mensaje1"
cuerpo = "cuerpo"
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(25)
.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") = "[email protected]"
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "xxxxxxx"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
End With
With Email
.To = "[email protected]"
.From = "[email protected]"
.Subject = mensaje
.TextBody = cuerpo
.Configuration.Fields.Update
On Error Resume Next
.Send
End With
If Err.Number = 0 Then
MsgBox "El mail se envió con éxito", vbInformation, "Informe"
Else
MsgBox "Se produjo el siguiente error: " & Err.Description, vbCritical, "Error nro " & Err.Number
End If
End Sub
1 Respuesta
Te anexo la macro actualizada para enviar la hoja activa como archivo de pdf.
Actualiza los siguientes datos en la macro con tus datos:
correo = "[email protected]" passwd = "pwd" nombre = "archivo.pdf"
La macro:
Sub EnviarArchivo() 'Por.Dante Amor ' correo = "[email protected]" passwd = "pwd" nombre = "archivo.pdf" ' Application.DisplayAlerts = False Application.ScreenUpdating = False ruta = ThisWorkbook.Path & "\" ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, _ Filename:=ruta & nombre, Quality:=xlQualityStandard, _ IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False ' Dim Email As CDO.Message 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 = "[email protected]; [email protected]" .From = correo .Subject = "asunto de mensaje" .TextBody = "Cuerpo del coreo" .AddAttachment ruta & "archivo.pdf" .Configuration.Fields.Update On Error Resume Next .Send End With If Err.Number = 0 Then MsgBox "El mail se envió con éxito" Else MsgBox "Se produjo el siguiente error: " & Err.Number & " " & Err.Description End If Set Email = Nothing End Sub
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
