Macro para imprimir PDF y enviarlo por mail

H o  l a:

Te anexo la macro para enviar por Gmail, actualiza los siguientes datos en la macro:

“Hoja1” por el nombre de tu hoja que quieras enviar.

"[email protected]" por tu correo de gmal.

"pwd" por tu password de gmail.

"[email protected]; [email protected]" por los correos de los destinatarios.

Sub EnviarHoja()
'Por.Dante Amor
    hoja = "Hoja1"
    correo = "[email protected]"
    passwd = "pwd"
    destino = "[email protected]; [email protected]"
    '
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    ruta = ThisWorkbook.Path & "\"
    nombre = "OC " & Sheets(hoja).Name
    Sheets(hoja).Copy
    ActiveWorkbook.SaveAs Filename:=ruta & nombre & ".xlsx"
    ActiveWorkbook.Close 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 = destino
        .From = correo
        .Subject = nombre
        .TextBody = "Envío Orden de Compra para su Atención"
        .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

Dante, Muchas Gracias esta muy bien, solo que el nombre de la hoja cambia cada vez que hago una orden de compra diferente, ósea son varias hojas cada una diferente de la otra, aunque el rango siempre es el mismo de B1:K24. El otro punto es que me piden que lo mande como PDF. será que se pueda ajustar la macro? Gracias.

Tienes razón la petición es para enviar un rango de la hoja activa como PDF.

Te anexo la macro actualizada para enviar un rango de la hoja activa.

Sub EnviarHoja()
'Por.Dante Amor
    correo = "[email protected]"
    passwd = "pwd"
    destino = "[email protected]; [email protected]"
    '
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    ruta = ThisWorkbook.Path & "\"
    nombre = "OC " & ActiveSheet.Name
    '
    Range("B1:K24").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 = destino
        .From = correo
        .Subject = nombre
        .TextBody = "Envío Orden de Compra para su Atención"
        .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

‘

R ecuerda cambiar la valoración de la respuesta. G r a c i a s

¡Gracias! Lo voy a activar para ver como trabaja, y te comento. 

Muchas gracias por el apoyo. Saludos.

Dante veo que tienes mucha experiencia en el tema, si yo te pidiera una seria de macros, para agilizar mis hojas de excel, hay manera de contactarte, cuanto me podría costar?

Saludos.

¿Hola Dante una duda veo que en la nueva programación en de With Mail donde dice addattachment tienes una extensión xlsx no debería ser PDF? Y otra cosa quise probar la Macro en mi hoja de excel, y no me funciono, pegue la macro y no la pude ver en la listada en la relación de macros a ejecutar, ¿me ayudas en esto? Saludos.

Cambia esto

.AddAttachment ruta & nombre & ".xlsx"

Por esto:

. AddAttachment ruta & nombre & ".pdf"

Sigue las Instrucciones para un botón y ejecutar la macro

1. Abre tu libro de Excel
2. Para abrir Vba-macros y poder pegar la macro, Presiona Alt + F11
3. En el menú elige Insertar / Módulo
4. En el panel del lado derecho copia la macro
5. Ahora para crear un botón, puedes hacer lo siguiente:
6. Inserta una imagen en tu libro, elige del menú Insertar / Imagen / Autoformas
7. Elige una imagen y con el Mouse, dentro de tu hoja, presiona click y arrastra el Mouse para hacer grande la imagen.
8. Una vez que insertaste la imagen en tu hoja, dale click derecho dentro de la imagen y selecciona: Tamaño y Propiedades. En la ventana que se abre selecciona la pestaña: Propiedades. Desmarca la opción “Imprimir Objeto”. Presiona “Cerrar”
9. Vuelve a presionar click derecho dentro de la imagen y ahora selecciona: Asignar macro. Selecciona: EnviarHoja
10. Aceptar.
11. Para ejecutarla dale click a la imagen.

sal u dos

Gracias Dante, hice todo lo que me indicaste y me salió este error:

Error de compilación:

Se esperaba: =
(Módulo2 2:16)

Como lo puedo solucionar. Saludos

Te comento que esta macro la estoy corriendo en Excel 2016 para Mac, en caso de que tuviera alguna diferencia. Gracias.