Macro envío por correo Excel
Muy buena tarde:
Tengo una rutina que de un formato lo copia en un nuevo libro y lo adjunta automáticamente en el manejador de correo (Outlook) con extensión .xlsx
On Error Resume Next
Dim sLibro As String
Application.ScreenUpdating = False
sLibro = ThisWorkbook.Name
Pedido.Copy
ActiveWorkbook.Colors = Workbooks(sLibro).Colors
Cells.Copy
Cells.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Range("A1").Select
ActiveSheet.Shapes("cmdMail").Delete
Application.Dialogs(xlDialogSendMail).Show
ActiveWorkbook.Close False
La pregunta es: Como puedo cambiar la extensión por .pdf? Para que no sea modificable.
Gracias y excelente tarde
1 Respuesta
Primero debes mandarlo a una impresora PDF.
Hay una impresora que se llama PDF Creator, lo puedes buscar en la red.
Es como si mandaras a imprimir pero en lugar de imprimir en papel te lo envía a un formato PDF. De ahi ya lo puedes enviar a un correo
Claro, entiendo lo que me dices. No solo PDF Creator, Adobe Reader, etc. Pero dentro de la rutina que coloque hacer la transformación a nivel programación.
Saludos
Sub correoeEnviarPDF()
Dim Email, ruta, ahora, LIBRO, ArchivoPdf As String
Dim ProgCorreo, CorreoSaliente As Object
With Application
.ScreenUpdating = False
.EnableEvents = False
.DisplayAlerts = False
End With
'aqui seleccione la A1 suponiendo que ahi tienes el correo a donde enviaras
Set Email = Range("a1")
ruta = ThisWorkbook.Path
LIBRO = ActiveSheet.Name & ".pdf"
ArchivoPdf = ruta & LIBRO
Set ProgCorreo = CreateObject("Outlook.Application")
Set CorreoSaliente = ProgCorreo.CreateItem(0)
With ActiveSheet
.ExportAsFixedFormat Type:=xlTypePDF, Filename:=ArchivoPdf, _
Quality:= _
xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=False
End With
On Error Resume Next
With CorreoSaliente
.to = Email
.CC = "[email protected]" 'correo de muestra
.BCC = ""
.Subject = "Archivo de Prueba"
.Body = "Aqui va el texto en el cuerpo" & Chr(13) & _
"espero se reciba correctamente" _
& Chr(13) & "Atentamente..."
.Attachments.Add ArchivoPdf
.Display 'o .Send para enviar sin ver
End With
On Error GoTo 0
Set CorreoSaliente = Nothing
Set ProgCorreo = Nothing
With Application
.ScreenUpdating = True
.EnableEvents = True
.DisplayAlerts = True
End With
End Sub
No Olvides Finalizar y puntuar la pregunta
