Te anexo la macro. Sigue los siguientes pasos:
1. Entra a VBA, al menú herramientas, Referencias, y activa la referencia "Microsoft CDO for Windows 2000 Library"
2. En la macro deberás poner tu usuario y password de tu gmail (no lo publiques en este foro)
correo = "[email protected]" 'correo de gmail
passwd = "pwd" 'pass de gmail
3. También en la macro deberás poner la hoja y la celda:
hoja = "Hoja1" 'Nombre de la hoja
celda = "D9" 'celda con el nombre de archivo
4. Así como los datos que van en el correo, destinatario, asunto y cuerpo del correo:
para = "[email protected]" 'destinatario
asunto = "Hoja de Entrega" 'asunto del correo
cuerpo = "Se anexa archivo" 'cuerpo del correo
5. En tu cuenta de gmail deberás activar el "Acceso de aplicaciones menos seguras"
https://www.google.com/settings/security/lesssecureapps
La macro completa:
Sub EnviarHoja()
'Por.Dante Amor
correo = "[email protected]" 'correo de gmail
passwd = "pwd" 'pass de gmail
hoja = "Hoja1" 'Nombre de la hoja
celda = "D9" 'celda con el nombre de archivo
'
para = "[email protected]" 'destinatario
asunto = "Hoja de Entrega" 'asunto del correo
cuerpo = "Se anexa archivo" 'cuerpo del correo
'
Set h1 = Sheets(hoja)
ruta = ThisWorkbook.Path & "\"
nombre = h1.Range(celda)
If nombre = "" Then
MsgBox "Falta el nombre de archivo"
Exit Sub
End If
'
h1.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=ruta & nombre & ".pdf", _
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 = para
.From = correo
.Subject = asunto
.TextBody = cuerpo
.AddAttachment ruta & nombre & ".xlsx"
.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