Macro que Crea PDF y Envía El PDF por Outlook

De la manera más amable solicito ayuda, ya he creado una macro que me permite hacer un archivo en PDF, lo que requiero es que el archivo que fue creado sea enviado vía por medio de Outlook. Adjunto código de la macro para crear el PDF.

Sub GeneraInformePDF()
'Da nombre al archivo
Worksheets("Presentación").Select
Dim Nombrearchivo As String
Nombrearchivo = Range("AI1")
' Macro que guarda las hojas en PDF
Sheets(Array("EDIFICIO P", "MUSEO", "MANZANA", "ÁREA CAJAS", "CENTRAL EFECTIVO", _
"CENTRAL EFECTIVO S", "Información final")).Select
Sheets("EDIFICIO P").Activate
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"C:\Users\Juan Carlos\Desktop\Funcionario Disponible\" & Nombrearchivo & ".pdf" _
, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=False
'Borra lainformación de los demás informesde manera conjunta
Sheets(Array("EDIFICIO P", "MUSEO", "MANZANA", "ÁREA CAJAS", "CENTRAL EFECTIVO", _
"CENTRAL EFECTIVO S")).Select
Sheets("EDIFICIO P").Activate
Range("A6").Select
Range(Selection, Selection.End(xlToRight)).Select
Rows("6:1050").Select
Selection.Delete Shift:=xlUp
' BorraInformacionFinal Macro
Sheets("Información final").Select
Range("B6").Select
Selection.ClearContents
Range("A11:E11").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Delete Shift:=xlToLeft
Range("A10:D10").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
End With
Sheets("Presentación").Select
End Sub

Cabe recordar que el archivo que se guarda en PDF tiene un nombre que cambia de acuerdo a una celda, la cual tiene la formula de hora, por lo que siempre es diferente.

1 Respuesta

Respuesta
2

Ademas del archivo necesitamos decirle a quien va dirgido, de donde vamos a obtener al destinatario, el asunto y si debe llevar algo el cuerpo del mensaje. Que version de excel tienes.

Saludos. Dam

Hola,

Primero quiero agradecer la prontitud en tu respuesta. La versión de excel que uso es 2010, requiero anexarle una serie de destinatarios, los cuales están en una celda, un asunto que también se encuentra en una celda, y lo mismo el mensaje.

Se que esto se puede hacer con variables, pero la verdad no es tan claro para mi como debo hacer para que el archivo que convierte en PDF lo envíe de manera automática. El problema se presenta porque el archivo creado siempre tiene un nombre que cambia de acuerdo a la hora.

En esta instrucción de tu macro se obtiene el nombre para guardar el PDF

Nombrearchivo = Range("AI1")

Supongo que en esa celda AI1 tienes una hora.

Cuando tenga lista la macro te la envío, para que tome los destinatarios de una celda, el asunto de una celda y el mensaje de una celda, le voy a poner 3 celdas distintas y tu las cambias, sería más sencillo si me dijeras cuáles celdas quieres.

Los destinatarios en tu celda deberán estar separados por ; (punto y coma).

Saludos. Dam

Te regreso la macro con las líneas para enviar el correo.

Sub GeneraInformePDF()
'Da nombre al archivo
Worksheets("Presentación").Select
Dim Nombrearchivo As String
Nombrearchivo = Range("AI1")
' Macro que guarda las hojas en PDF
Sheets(Array("EDIFICIO P", "MUSEO", "MANZANA", "ÁREA CAJAS", "CENTRAL EFECTIVO", _
"CENTRAL EFECTIVO S", "Información final")).Select
Sheets("EDIFICIO P").Activate
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"C:\Users\Juan Carlos\Desktop\Funcionario Disponible\" & Nombrearchivo & ".pdf" _
, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=False
Ruta = "C:\Users\Juan Carlos\Desktop\Funcionario Disponible\"
Archivo = Nombrearchivo
    Set parte1 = CreateObject("outlook.application")
    Set parte2 = parte1.createitem(olmailitem)
    parte2.to = Range("B2") 'Destinatarios
    parte2.Subject = Range("C2") '"Asunto"
    parte2.body = Range("C2") '"Cuerpo del mensaje"
    Parte2. Attachments.Add Ruta & Archivo
    parte2. Send 'El correo se envía en automático
 'parte2. Display 'El correo se muestra
'Borra lainformación de los demás informesde manera conjunta
Sheets(Array("EDIFICIO P", "MUSEO", "MANZANA", "ÁREA CAJAS", "CENTRAL EFECTIVO", _
"CENTRAL EFECTIVO S")).Select
Sheets("EDIFICIO P").Activate
Range("A6").Select
Range(Selection, Selection.End(xlToRight)).Select
Rows("6:1050").Select
Selection.Delete Shift:=xlUp
' BorraInformacionFinal Macro
Sheets("Información final").Select
Range("B6").Select
Selection.ClearContents
Range("A11:E11").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Delete Shift:=xlToLeft
Range("A10:D10").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
End With
Sheets("Presentación").Select
End Sub

Cambia las celdas que van en la macro por las celdas reales donde tienes los datos.

parte2.to = Range("B2") 'Destinatarios
parte2.Subject = Range("C2") '"Asunto"
parte2.body = Range("C2") '"Cuerpo del mensaje"

Saluods. Dam

Si es lo que necesitas.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas

DIBUJAR CELDAS con macros

Tengo una Base de Datos en la que estoy asignando valores por medio de un UserForm de la sig forma: ActiveCell = TextBox1 '(TextBox2, ComboBox1, etc, etc..) El UserForm llena toda una fila de mil columnas en la base de datos. Y me gustaría poner una...
1 respuesta

Bordes con macro

Recurro a ustedes una vez mas. Tengo una simple macro que dibuja bordes negros en el exterior y grises en el interior ( un formato que uso muy habitualmente ) Funciona correctamente salvo en la ocasión en que solo tenga seleccionada una sola celda:...
1 respuesta

Crear bordes

Respetuoso para todos y todas. Quiero darle borde a una cantidad no definida de filas y columnas, ¿Cómo se genera el código para lograrlo?
1 respuesta

Macro para Imprimir hoja en impresora que no es la predeterminada.

Me podrían ayudar a generar una macro para imprimir una un archivo en dos paginas y mandarla a otra impresora que no es la predeterminada, Tengo varias impresoras en red y la que uso predeterminada es una impresora matriz, el tema es que el reporte...
1 respuesta

Selección de varios rangos para aplicar formato

Bueno me voy de frente a explicar la macro que deseo hacer, primero debe seleccionar un rango dado pejm (B6:F30), ahora seleccionar rangos dentro de este pejm (B6:F6) aplicarle negrita, centrado y todo los bordes; (B7:B30) aplicarle borde externo;...
1 respuesta

Sobre macros en Excel

Me encargaron en la escuela dos ejercicios para hacerlos en excel pero no tengo mucha experiencia haciendo macros,.. ¿Podrías ayudarme? Los ejercicios son los siguientes: ---------- Crea una macro llamada PonerTitulo que realice las siguientes...
1 respuesta

Macro sumar rangos en columna

Necesito una macro. Tengo una columna donde arrojo una lista de valores, pero no esta definido el rango en el que aparecen. Puede ser desde la J1 hasta J3000 o infinito.. La idea es que me sume esos valores y los totalice con raya para la suma...
1 respuesta