Macro para enviar pdf + hoja de excel en un mismo correo a varios destinatarios

Desde Guayaquil - Ecuador, estoy realizando una programación de VBA para enviar una hoja de excel a varios destinatarios y dentro de esa hoja una rango especifico lo convierto en pdf, pero no logro enviarlos ambos en el mismo correo

Mi correo es [email protected]

1 Respuesta

Respuesta
2

Sale macro para enviar una hoja y un rango en pdf por correo.

Sub Macro4()
'Enviar una hoja por correo
'por.dam
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set h2 = Sheets("Hoja2")
rango = "A1:D10"
    wpath = ThisWorkbook.Path & "\"
    h2.Select
    nombre = ActiveSheet.Name
    h2.Copy
    ActiveWorkbook.SaveAs Filename:=wpath & nombre & ".xls", _
        FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False
    ActiveWorkbook. Close
    h2.Range(rango).Copy
    Sheets.Add
    ActiveSheet.Paste
    n2 = ActiveSheet.Name
    ActiveSheet.Copy
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
        Filename:=wpath & nombre & ".pdf", _
        Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, _
        OpenAfterPublish:=False
    ActiveWorkbook.Close
    Sheets(n2).Delete
    Set dam1 = CreateObject("outlook.application")
    Set dam2 = dam1.createitem(olmailitem)
    dam2.to = "[email protected]" 'Destinatarios
    dam2.cc = "[email protected]" 'Con copia
    dam2.bcc = "[email protected]" 'Con copia oculta
    dam2.Subject = "asunto" '"Asunto"
    dam2.body = "cuerpo"  '"Cuerpo del mensaje"
    dam2.Attachments.Add wpath & nombre & ".xls"
    dam2.Attachments.Add wpath & nombre & ".pdf"
    dam2.display 'El correo se muestra
    'dam2.send
End Sub

Pon en la macro tu hoja y tu rango en esta parte

Set h2 = Sheets("Hoja2")
rango = "A1:D10"

Saludos. DAM
Si es lo que necesitas.

muchísimas gracias por tu pronta respuesta, le estoy tratando de ejecutar pero me genera siguiente error.

lo que esta subrayado y cursiva es lo que yo modifique de la programación que inicialmente me enviaste

Sub Macro4()
'Enviar una hoja por correo
'por.dam
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set h2 = Sheets("MIHOJA")
rango = "A1:G25"
wpath = ThisWorkbook.Path & "\"
h2.Select
nombre = ActiveSheet.Select
h2.Copy
ActiveWorkbook.SaveAs Filename:=wpath & nombre & ".xls", _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
ActiveWorkbook.Close
h2.Range("A1:G25").Copy
Sheets.Add
ActiveSheet.Paste
n2 = ActiveSheet.Name
ActiveSheet.Copy
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=wpath & nombre & ".pdf", _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
ActiveWorkbook.Close
Sheets(n2).Delete
Set dam1 = CreateObject("outlook.application")
Set dam2 = dam1.createitem(olmailitem)
dam2.to = Range("A1") 'Destinatarios
dam2.cc = Range("A2") 'Con copia
dam2.bcc = "" 'Con copia oculta
dam2.Subject = "REPORTE GENERAL OPL PLACAS - CLIENTES - CARGUE" & " " & Format(Now, "dd-mm-yy") '"Asunto"
dam2.body = "Estimados envío el reporte general de cargue, clientes y placas del dia."
dam2.Attachments.Add wpath & nombre & ".xls"
dam2.Attachments.Add wpath & nombre & ".pdf"
dam2.display 'El correo se muestra
'dam2.send
End Sub

¿Y qué error te manda?

¿También dime si le das depurar cuál línea se pone de amarillo?

Revisa también si el primer archivo te lo está guardando como xls o como xlsx, si te lo guarda como xlsx, entonces cambia en la macro en donde diga xls por xlsx

ok te detallo el error. "ERROR DE COMPILACIÓN: NO SE HA DEFINIDO SUB O FUNCTION"

SE PINTA DE AMARILLO

Sub Macro4()
'Enviar una hoja por correo
'por.dam
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set h2 = Sheets("dibece")
rango = "A1:G25"
wpath = ThisWorkbook.Path & "D:\REPORTES GENERALES\"
h2.Select
nombre = ActiveSheet.Select
h2.Copy

A PARTIR DE AQUÍ SE PINTA EN ROJO LAS LETRAS
ActiveWorkbook.SaveAs Filename:=wpath & nombre & ".xls", _
FileFormat:=xlNormal, Password:="123", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False


ActiveWorkbook.Close
h2.Range("A1:G25").Copy
Sheets.Add
ActiveSheet.Paste
n2 = ActiveSheet.Name
ActiveSheet.Copy

A PARTIR DE AQUÍ SE PINTA EN ROJO LAS LETRAS
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=wpath & nombre & ".pdf", _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
ActiveWorkbook.Close
Sheets(n2).Delete
Set dam1 = CreateObject("outlook.application")
Set dam2 = dam1.createitem(olmailitem)
dam2.to = Range("A1") 'Destinatarios
dam2.cc = Range("A2") 'Con copia
dam2.bcc = "" 'Con copia oculta
dam2.Subject = "REPORTE GENERAL OPL PLACAS - CLIENTES - CARGUE" & " " & Format(Now, "dd-mm-yy") '"Asunto"
dam2.body = "Estimados envío el reporte general de cargue, clientes y placas del dia."
dam2.Attachments.Add wpath & nombre & ".xls"
dam2.Attachments.Add wpath & nombre & ".pdf"
dam2.display 'El correo se muestra
'dam2.send
End Sub

Te anexo mi archivo, antes de que le hagas cambios a la macro prueba con mi archivo.

https://www.dropbox.com/s/dhg3nlhbmg2byzy/correo%20hoja%20y%20rango%20pdf.xlsm

en el link no me sale ninguna información.

Envíame tu archivo y le adapto la macro, dime que hoja y qué rango quieres enviar

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas