Adjuntar varios archivos en un correo por macro
Tengo esta macro que me envía un archivo en pdf, más concretamente la Hoja1 y ahora necesito enviar la Hoja1 y Hoja2 en pdf. No doy con la tecla, ¿alguno de vosotros me podéis ayudar?
Adjunto macro usada ahora para adjuntar la Hoja1 en pdf al correo:
Sub distribucion ()
Dim Asunto As String
Asunto = "Archivo " & Range("L6")
Application.ScreenUpdating = False
Application.DisplayAlerts = False
des = Range("A1")
Set h2 = ThisWorkbook
wpath = ThisWorkbook.Path & "\"
Nombre = h2.Name
Sheets("Hoja1").ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=wpath & Nombre & ".pdf", _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
Set dam1 = CreateObject("outlook.application")
Set dam2 = dam1.createitem(olmailitem)
dam2.to = ""
dam2.cc = " "
dam2.Subject = Asunto
dam2.Body = "Adjunto archivos"
dam2.Attachments.Add wpath & Nombre & ".pdf"
dam2.display
DoEvents
Kill wpath & Nombre & ".pdf"
Kill "Hoja2" & Nombre & ".pdf"
DoEvents
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
2 respuestas
Haz el mismo proceso para hoja 2
Sheets("Hoja2").ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=wpath & Nombre & ".pdf", _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
Y al envío del correo agrega otra vez el adjunto
dam2.Attachments.Add wpath & Nombre & ".pdf"
Sólo sustituye el nombre
Cuando llegues a Display, verás los 2 PDF adjuntados
Otra forma es que mandes en un solo PDF las 2 hojas
Para eso antes de generar el PDF selecciona la hoja 1 y la hoja 2
Es decir
Sheets(array("hoja1", "hoja2")). Select
Activesheet.exportAsFixedFormat type:=xltypePDF
H o l a:
Te anexo la macro actualizada:
Sub distribucion()
'Por.Dante Amor
Dim Asunto As String
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Asunto = "Archivo " & Range("L6")
des = Range("A1")
Set l1 = ThisWorkbook
wpath = l1.Path & "\"
Nombre = l1.Name
Sheets(Array("Hoja1", "Hoja2")).Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=wpath & Nombre & ".pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=False
Set dam1 = CreateObject("outlook.application").createitem(olmailitem)
dam1.To = ""
dam1.Cc = " "
dam1.Subject = Asunto
dam1.Body = "Adjunto archivos"
dam1.Attachments.Add wpath & Nombre & ".pdf"
dam1.Display
DoEvents
Kill wpath & Nombre & ".pdf"
Sheets("Hoja1").Select
End Sub' : ) 'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias ' : )
hola, quiero que aparezcan los pdf´s por separado en el correo y estoy intentando usar este código:
Dim Asunto As String
Asunto = "Archivo " & Range("L6")
Application.ScreenUpdating = False
Application.DisplayAlerts = False
des = Range("A1")
Set h2 = ThisWorkbook
Set h1 = Sheets("Hoja identificativa ")
wpath = ThisWorkbook.Path & "\"
Nombre = h2.Name
Nombre2 = h1.Name
Sheets("edicion").ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=wpath & Nombre & ".pdf", _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
Sheets("Hoja identificativa ").ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=wpath & Nombre2 & ".pdf", _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
Set dam1 = CreateObject("outlook.application")
Set dam2 = dam1.createitem(olmailitem)
dam2.to = ""
dam2.cc = ""
dam2.Subject = Asunto
dam2.Body = "Adjunto archivo."
dam2.Attachments.Add wpath & Nombre & ".pdf"
dam2.Attachments.Add wpath & Nombre2 & ".pdf"
dam2.display
DoEvents
Kill wpath & Nombre & ".pdf"
DoEvents
Set OutMail = Nothing
Set OutApp = Nothing
Pero me da error de ejecución: "el archivo no se guardó"
H o l a:
Te anexo la macro actualizada para generar 2 archivos.
Observa como declaro L1 como objeto del Libro y como declaro h1 y h2 como los objetos de las hojas.
Los nombres de los archivos estarán identificados con los nombres de las hojas:
nombre1 = h1.Name
nombre2 = h2.Name
Revisa que el nombre de la hoja "Hoja identificativa " esté bien escrito, ya que observo un espacio al final del nombre.
Sub distribucion()
'Por.Dante Amor
Dim Asunto As String
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set l1 = ThisWorkbook
Set h1 = Sheets("Hoja identificativa ")
Set h2 = Sheets("edicion")
'
Asunto = "Archivo " & Range("L6")
des = Range("A1")
wpath = l1.Path & "\"
nombre1 = h1.Name
nombre2 = h2.Name
h1.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=wpath & nombre1 & ".pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=False
h2.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=wpath & nombre2 & ".pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=False
Set dam1 = CreateObject("outlook.application").createitem(olmailitem)
dam1.To = ""
dam1.Cc = " "
dam1.Subject = Asunto
dam1.Body = "Adjunto archivos"
dam1.Attachments.Add wpath & nombre1 & ".pdf"
dam1.Attachments.Add wpath & nombre2 & ".pdf"
dam1.Display
DoEvents
Kill wpath & nombre1 & ".pdf"
Kill wpath & nombre2 & ".pdf"
End SubSal u dos