Enviar pdf de varias hojas por correo
Tengo una macro para enviar por correo un pdf con varias hojas en función de las hojas de un libro de excel pero no me funciona. Se trata de enviar en pdf las hojas 1,2 o 3 si existieran.
Adjunto código:
Sub aviso()
Application.ScreenUpdating = True
Application.DisplayAlerts = False
On Error Resume Next
Dim SaveName As String
SaveName = ThisWorkbook.Name
ActiveWorkbook.SaveAs Filename:="\\Client\D$\usarios\" & _
SaveName
Dim Asunto As String
Asunto = "Aviso" & Sheets("Hoja_1").Range("G3")
Dim ReportSheet As Worksheet
On Error Resume Next
Set ReportSheet = Sheets("Grafik_1")
Set ReportSheet2 = Sheets("Grafik_2")
Set ReportSheet3 = Sheets("Grafik_3")
Application.ScreenUpdating = False
Application.DisplayAlerts = False
des = Range("A1")
Set h2 = ThisWorkbook
wpath = ThisWorkbook.Path & "\"
Nombre = h2.Name
If ReportSheet Is Nothing Then
Else
Sheets("Hoja_1").ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=wpath & Nombre & ".pdf", _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
If ReportSheet2 Is Nothing Then
Else
Sheets("Hoja_1" & "Hoja_2").ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=wpath & Nombre2 & ".pdf", _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
If ReportSheet3 Is Nothing Then
Else
Sheets("Hoja_1" & "Hoja_2" & "Hoja_3").ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=wpath & Nombre2 & ".pdf", _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
End If
End if
End if
Set dam1 = CreateObject("outlook.application")
Set dam2 = dam1.createitem(olmailitem)
dam2.To = ""
dam2.cc = ""
dam2.Subject = Asunto
dam2.Body = "Buenas," & Chr(13) & _
"Adjunto ............................................................." _
& Chr(13) & "Atentamente."
dam2.Attachments.Add wpath & Nombre & ".pdf"
dam2.send
DoEvents
Kill wpath & Nombre & ".pdf"
DoEvents
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
1 Respuesta
Al final lo he conseguido, adjunto la macro para enviar un correo del Excel convirtiendo varias hojas de ese Excel según su nombre:
Sub envio_por_correo
Dim SaveName As String
SaveName = ThisWorkbook.Name
ActiveWorkbook.SaveAs Filename:="\\\Client\D$\USUARIOS\carpeta\" & _
SaveName
Dim i As Integer
For i = 1 To Worksheets.Count
If Left(Worksheets(i).Name, 6) = "Hoja" Then
Sheets(i).Activate
End If
Next i
If ActiveSheet.Name = "Hoja_1" Then
Sheets("Hoja_1").Select
Else
If ActiveSheet.Name = "Hoja_2" Then
Sheets(Array("Hoja_1", "Hoja_2")).Select
Else
If ActiveSheet.Name = "Hoja_3" Then
Sheets(Array("Hoja_1", "Hoja_2", "Hoja_3")).Select
Else
If ActiveSheet.Name = "Hoja_4" Then
Sheets(Array("Hoja_1", "Hoja_2", "Hoja_3", "Hoja_4")).Select
Else
If ActiveSheet.Name = "Hoja_5" Then
Sheets(Array("Hoja_1", "Hoja_2", "Hoja_3", "Hoja_4", "Hoja_5")).Select
Else
If ActiveSheet.Name = "Hoja_6" Then
Sheets(Array("Hoja_1", "Hoja_2", "Hoja_3", "Hoja_4", "Hoja_5", "Hoja_6")).Select
Else
If ActiveSheet.Name = "Hoja_7" Then
Sheets(Array("Hoja_1", "Hoja_2", "Hoja_3", "Hoja_4", "Hoja_5", "Hoja_6", "Hoja_7")).Select
Else
If ActiveSheet.Name = "Hoja_8" Then
Sheets(Array("Hoja_1", "Hoja_2", "Hoja_3", "Hoja_4", "Hoja_5", "Hoja_6", "Hoja_7", "Hoja_8")).Select
Else
If ActiveSheet.Name = "Hoja_9" Then
Sheets(Array("Hoja_1", "Hoja_2", "Hoja_3", "Hoja_4", "Hoja_5", "Hoja_6", "Hoja_7", "Hoja_8", "Hoja_9")).Select
Else
If ActiveSheet.Name = "Hoja_10" Then
Sheets(Array("Hoja_1", "Hoja_2", "Hoja_3", "Hoja_4", "Hoja_5", "Hoja_6", "Hoja_7", "Hoja_8", "Hoja_9", "Hoja_10")).Select
Else
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
Dim Asunto As String
Asunto = "Información solicitada " & Sheets("Hoja_1").Range("G3")
On Error Resume Next
des = Range("A1")
Set h2 = ThisWorkbook
wpath = ThisWorkbook.Path & "\"
Nombre = h2.Name
ActiveSheet.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 = "Buenas," & Chr(13) & _
"Adjunto información solicitada." _
& Chr(13) & "Atentamente."
dam2.Attachments.Add wpath & Nombre & ".pdf"
dam2.send
DoEvents
Kill wpath & Nombre & ".pdf"
DoEvents
Set OutMail = Nothing
Set OutApp = Nothing
End sub
