Hoy vamos a aprender cómo enviar automáticamente un informe Excel por email usando una macro.
Para ello, vamos a darle una vuelta de tuerca al ejercicio práctico 5, donde veíamos cómo filtrar los registros de una tabla, repartiéndolos en varias hojas mediante macros. En él, repartíamos los registros de un listado en distintas hojas, en función de uno o más criterios.
Y, ¿cuál sería el siguiente paso? Claro está, que una vez tenemos la información clasificada, lo interesante es hacérsela llegar a cada responsable para que actué en consecuencia, y qué mejor manera que hacerlo desde Excel a través de un email usando una macro.
Por lo tanto, la idea es que, al pulsar un nuevo botón, se envíen tres correos electrónicos a tres grupos de destinatarios diferentes, uno por cada hoja clasificada. De hecho, cada correo contendrá la información de un solo grupo, por lo que será necesario que se generen automáticamente dichos archivos individuales previo al envío.
A continuación, os dejo el código para enviar automáticamente un informe de Excel por email usando una macro:
Macro 1. Generar informes de materiales según grupo de trabajo.
'Desactivamos el refresco de pantalla para agilizar la macro
Application.ScreenUpdating = False
'Buscamos la última fila con datos de cada hoja
Sheets("Grupo 1").Select
filagrupo1 = Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
Sheets("Grupo 2").Select
filagrupo2 = Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
Sheets("Grupo 3").Select
filagrupo3 = Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
'Recorremos los registros de la tabla y repartiéndolos en el resto de hojas en función del grupo de trabajo
Sheets("Informe").Select
f = Cells(Rows.Count, 1).End(xlUp).Offset(0, 0).Row
For i = 2 To f
Sheets("Informe").Select
'Si pertenece al GRUPO 1
If Cells(i, "K") = 1 Then
Range(Cells(i, "A"), Cells(i, "K")).Select
Selection.Copy
Sheets("Grupo 1").Select
Cells(filagrupo1, "A").Select
Selection.PasteSpecial Paste:=xlPasteAll, operation:=xlNone, skipblanks _
:=False, Transpose:=False
filagrupo1 = filagrupo1 + 1
goto salto
End If
'Si pertenece al GRUPO 2
If Cells(i, "K") = 2 Then
Range(Cells(i, "A"), Cells(i, "K")).Select
Selection.Copy
Sheets("Grupo 2").Select
Cells(filagrupo2, "A").Select
Selection.PasteSpecial Paste:=xlPasteAll, operation:=xlNone, skipblanks _
:=False, Transpose:=False
filagrupo2 = filagrupo2 + 1
goto salto
End If
'Si pertenece al GRUPO 3
If Cells(i, "K") = 3 Then
Range(Cells(i, "A"), Cells(i, "K")).Select
Selection.Copy
Sheets("Grupo 3").Select
Cells(filagrupo3, "A").Select
Selection.PasteSpecial Paste:=xlPasteAll, operation:=xlNone, skipblanks _
:=False, Transpose:=False
filagrupo3 = filagrupo3 + 1
End If
salto:
Next
'Calculamos el importe total de cada grupo, dos filas más abajo del último registro
'GRUPO 1
Sheets("Grupo 1").Select
totalizar = Application.WorksheetFunction.Sum(Range(Cells(2, "E"), Cells(filagrupo1, "E")))
Cells(filagrupo1, "E") = totalizar
Cells(filagrupo1, "E").Select
With Selection
.HorizontalAlignment = xlCenter
End With
Selection.Font.Bold = True
'GRUPO 2
Sheets("Grupo 2").Select
totalizar = Application.WorksheetFunction.Sum(Range(Cells(2, "E"), Cells(filagrupo2, "E")))
Cells(filagrupo2, "E") = totalizar
Cells(filagrupo2, "E").Select
With Selection
.HorizontalAlignment = xlCenter
End With
Selection.Font.Bold = True
'GRUPO 3
Sheets("Grupo 3").Select
totalizar = Application.WorksheetFunction.Sum(Range(Cells(2, "E"), Cells(filagrupo3, "E")))
Cells(filagrupo3, "E") = totalizar
Cells(filagrupo3, "E").Select
With Selection
.HorizontalAlignment = xlCenter
End With
Selection.Font.Bold = True
'Llamamos a la macro para ordenar el informe
Call Ordenfinal
'Abrimos la hoja Grupo 1
Sheets("Informe").Select
'Activamos el refresco de pantalla
Application.ScreenUpdating = True
End Sub
Macro 2. Borrar informes de materiales.
'Desactivamos el refresco de pantalla para agilizar la macro
Application.ScreenUpdating = False
'Mostramos mensaje de aviso porque se borrarán datos
resultado = MsgBox("¿Seguro? Se perderán los cálculos", vbYesNo + vbExclamation, "Advertencia")
Select Case resultado
Case vbNo:
GoTo final
End Select
'Borramos los datos de las hojas de Grupos
Sheets("Grupo 1").Activate
Range("A2:K500").ClearContents
Sheets("Grupo 2").Activate
Range("A2:K500").ClearContents
Sheets("Grupo 3").Activate
Range("A2:K500").ClearContents
'Volvemos a la hoja Informe
Sheets("Informe").Activate
final:
'Desactivamos el refresco de pantalla para agilizar la macro
Application.ScreenUpdating = True
End Sub
Macro 3. Ordenar informes según importe descendente.
'Ordenamos las hojas de los grupos por el campo importe, de mayor a menor
'GRUPO 1
Sheets("Grupo 1").Select
filagrupo1 = Cells(Rows.Count, 1).End(xlUp).Offset(0, 0).Row
Range(Cells(2, "A"), Cells(filagrupo1, "K")).Sort Key1:=Range("E:E"), Order1:=xlDescending, Header:=xlNo
'GRUPO 2
Sheets("Grupo 2").Select
filagrupo2 = Cells(Rows.Count, 1).End(xlUp).Offset(0, 0).Row
Range(Cells(2, "A"), Cells(filagrupo2, "K")).Sort Key1:=Range("E:E"), Order1:=xlDescending, Header:=xlNo
'GRUPO 3
Sheets("Grupo 3").Select
filagrupo3 = Cells(Rows.Count, 1).End(xlUp).Offset(0, 0).Row
Range(Cells(2, "A"), Cells(filagrupo3, "K")).Sort Key1:=Range("E:E"), Order1:=xlDescending, Header:=xlNo
'Abrimos la hoja Grupo 1
Sheets("Grupo 1").Select
End Sub
En primer lugar, deciros que la macro 1, que elabora el informe, es exactamente la misma que usamos en el ejercicio práctico 5, solo que he cambiado la penúltima instrucción:
Por,
Para que, al finalizar, aterricemos en la hoja “Informe” y podamos seguir pulsando botones.
También, las macros 2 y 3 son las mismas que usamos en el ejercicio práctico 5.
Por el contrario, las novedades son las macros 4 y 5, que aportan la creación automática de los archivos y el envío de correos.
Macro 4. Crear automáticamente archivos y llamar a función de envío de correos automáticos (Lotus).
'Macro para la creación de archivos individuales por grupo y envío de la información
'Desactivamos el refresco de pantalla
Application.ScreenUpdating = False
Dim wrkNuevo As Workbook
Dim hojasActual As Long
'Creamos un libro nuevo GRUPO 1
'Elegimos una sola hoja
Application.SheetsInNewWorkbook = 1
'Creamos el libro
Set wrkNuevo = Workbooks.Add
ActiveWorkbook.SaveAs Filename:="C:\Grupo1.xls", FileFormat:= _
xlNormal, CreateBackup:=False
'Copiamos la hoja del Grupo 1
Workbooks(1).Worksheets(2).Copy After:=Workbooks(2).Worksheets(1)
Set Nombre = Worksheets(2)
Nombre.Name = "Grupo 1"
Application.DisplayAlerts = False
Worksheets("Hoja1").Delete
Application.DisplayAlerts = True
'Vamos cerrando
Cells(1, 1).Select
ActiveWindow.ScrollRow = Cells(1, "A").Row
ActiveWindow.ScrollColumn = Cells(1, "A").Column
Application.DisplayAlerts = False
Workbooks("Grupo1.xls").Close Savechanges:=True
Application.DisplayAlerts = True
'Creamos un libro nuevo GRUPO 2
'Elegimos una sola hoja
Application.SheetsInNewWorkbook = 1
'Creamos el libro
Set wrkNuevo = Workbooks.Add
ActiveWorkbook.SaveAs Filename:="C:\Grupo2.xls", FileFormat:= _
xlNormal, CreateBackup:=False
'Copiamos la hoja del Grupo 1
Workbooks(1).Worksheets(3).Copy After:=Workbooks(2).Worksheets(1)
Set Nombre = Worksheets(2)
Nombre.Name = "Grupo 2"
Application.DisplayAlerts = False
Worksheets("Hoja1").Delete
Application.DisplayAlerts = True
'Vamos cerrando
Cells(1, 1).Select
ActiveWindow.ScrollRow = Cells(1, "A").Row
ActiveWindow.ScrollColumn = Cells(1, "A").Column
Application.DisplayAlerts = False
Workbooks("Grupo2.xls").Close Savechanges:=True
Application.DisplayAlerts = True
'Creamos un libro nuevo GRUPO 3
'Elegimos una sola hoja
Application.SheetsInNewWorkbook = 1
'Creamos el libro
Set wrkNuevo = Workbooks.Add
ActiveWorkbook.SaveAs Filename:="C:\Grupo3.xls", FileFormat:= _
xlNormal, CreateBackup:=False
'Copiamos la hoja del Grupo 1
Workbooks(1).Worksheets(4).Copy After:=Workbooks(2).Worksheets(1)
Set Nombre = Worksheets(2)
Nombre.Name = "Grupo 3"
Application.DisplayAlerts = False
Worksheets("Hoja1").Delete
Application.DisplayAlerts = True
'Vamos cerrando
Cells(1, 1).Select
ActiveWindow.ScrollRow = Cells(1, "A").Row
ActiveWindow.ScrollColumn = Cells(1, "A").Column
Application.DisplayAlerts = False
Workbooks("Grupo3.xls").Close Savechanges:=True
Application.DisplayAlerts = True
'Envío automático de emails
email "Gasto de materiales. Grupo1.", "correo1@vbatotal.com", "C:\Grupo1.xls"
email "Gasto de materiales. Grupo2.", Array("correo1@vbatotal.com", "correo2@vbatotal.com"), "C:\Grupo2.xls"
email "Gasto de materiales. Grupo3.", Array("correo1@vbatotal.com", "correo3@vbatotal.com"), "C:\Grupo3.xls"
'Activamos el refresco de pantalla
Application.ScreenUpdating = True
End Sub
Macro 5. Función para el envío de un email (Lotus) desde Excel usando una macro.
'Función para el envío automático de correos
Dim Maildb As Object
Dim mailDoc As Object
Dim body As Object
Dim session As Object
'Iniciamos la sesión en Lotus
Set session = CreateObject("Notes.NotesSession")
'Abrimos la base de datos de Lotus
Set Maildb = session.GetDatabase("", "names.nsf")
If Not Maildb.IsOpen = True Then
Call Maildb.Open
End If
'Creamos un nuevo correo
Set mailDoc = Maildb.CreateDocument
Call mailDoc.ReplaceItemValue("Form", "Memo")
'Los destinatarios del correo están definidos en la llamada de la función
Call mailDoc.ReplaceItemValue("SendTo", Recipient)
'El asunto del correo está definido en la llamada de la función
Call mailDoc.ReplaceItemValue("Subject", Subject)
'Contenido del correo
Set body = mailDoc.CreateRichTextItem("Body")
Call body.AppendText("Buenos días,")
Call body.AddNewLine(2)
Call body.AppendText("Adjunto archivo con los gastos de materiales.")
Call body.AddNewLine(2)
Call body.AppendText("Saludos.")
'Adjuntos del correo
Call body.AddNewLine(4)
Call body.EmbedObject(1454, "", Attachment)
Call body.AddNewLine(2)
'Pie del correo
Call body.AddNewLine(2)
Call body.AppendText("Este es un correo automático.")
'Envío del correo
Call mailDoc.ReplaceItemValue("PostedDate", Now())
Call mailDoc.send(False)
'Limpiamos
Set Maildb = Nothing
Set mailDoc = Nothing
Set body = Nothing
Set session = Nothing
End Sub
Empecemos primero analizando la macro 4.
Como siempre, en primer lugar, desactivamos el refresco de pantalla y dimensionamos las nuevas variables para el libro nuevo que vamos a crear.
'Macro para la creación de archivos individuales por grupo y envío de la información
'Desactivamos el refresco de pantalla
Application.ScreenUpdating = False
Dim wrkNuevo As Workbook
A continuación, seleccionamos el número de hojas que queremos que tenga nuestro nuevo libro,
'Creamos un libro nuevo GRUPO 1
'Elegimos una sola hoja
Application.SheetsInNewWorkbook = 1
Después, creamos el nuevo libro,
Set wrkNuevo = Workbooks.Add
y lo guardamos con el nombre “Grupo1.xls”
xlNormal, CreateBackup:=False
A continuación, copiamos la hoja 2 (Grupo 1) del libro 1 (Ejercicio practico 8.xlsx) detrás de la hoja 1 del nuevo libro,
Workbooks(1).Worksheets(2).Copy After:=Workbooks(2).Worksheets(1)
le damos el nombre “Grupo 1”,
Nombre.Name = "Grupo 1"
y borramos la hoja que trae por defecto el libro creado. Así mismo, hemos desactivado las alertas para no tener que validar el borrado de la misma.
Worksheets("Hoja1").Delete
Application.DisplayAlerts = True
Enfocamos la primera celda del nuevo libro, lo guardamos y lo cerramos.
Cells(1, 1).Select
ActiveWindow.ScrollRow = Cells(1, "A").Row
ActiveWindow.ScrollColumn = Cells(1, "A").Column
Application.DisplayAlerts = False
Workbooks("Grupo1.xls").Close Savechanges:=True
Application.DisplayAlerts = True
Aunque no veamos nada, ahora mismo tenemos el archivo de la imagen guardado en C:\> como “Grupo1.xls”.
De manera similar, realizamos las operaciones con los grupos 2 y 3.
'Elegimos una sola hoja
Application.SheetsInNewWorkbook = 1
'Creamos el libro
Set wrkNuevo = Workbooks.Add
ActiveWorkbook.SaveAs Filename:="C:\Grupo2.xls", FileFormat:= _
xlNormal, CreateBackup:=False
'Copiamos la hoja del Grupo 1
Workbooks(1).Worksheets(3).Copy After:=Workbooks(2).Worksheets(1)
Set Nombre = Worksheets(2)
Nombre.Name = "Grupo 2"
Application.DisplayAlerts = False
Worksheets("Hoja1").Delete
Application.DisplayAlerts = True
'Vamos cerrando
Cells(1, 1).Select
ActiveWindow.ScrollRow = Cells(1, "A").Row
ActiveWindow.ScrollColumn = Cells(1, "A").Column
Application.DisplayAlerts = False
Workbooks("Grupo2.xls").Close Savechanges:=True
Application.DisplayAlerts = True
'Creamos un libro nuevo GRUPO 3
'Elegimos una sola hoja
Application.SheetsInNewWorkbook = 1
'Creamos el libro
Set wrkNuevo = Workbooks.Add
ActiveWorkbook.SaveAs Filename:="C:\Grupo3.xls", FileFormat:= _
xlNormal, CreateBackup:=False
'Copiamos la hoja del Grupo 1
Workbooks(1).Worksheets(4).Copy After:=Workbooks(2).Worksheets(1)
Set Nombre = Worksheets(2)
Nombre.Name = "Grupo 3"
Application.DisplayAlerts = False
Worksheets("Hoja1").Delete
Application.DisplayAlerts = True
'Vamos cerrando
Cells(1, 1).Select
ActiveWindow.ScrollRow = Cells(1, "A").Row
ActiveWindow.ScrollColumn = Cells(1, "A").Column
Application.DisplayAlerts = False
Workbooks("Grupo3.xls").Close Savechanges:=True
Application.DisplayAlerts = True
Por último, una vez creados los tres libros, tenemos que enviarlos por correo a sus respectivos destinatarios.
Para ello, he creado una función llamada “email” que se encuentra en la macro 5 y nos facilita dicha operación, pasándole como parámetros el asunto del email, la lista de destinatarios y la ruta del archivo adjunto.
De esta manera, enviamos un email desde Excel usando una macro.
email "Gasto de materiales. Grupo1.", "correo1@vbatotal.com", "C:\Grupo1.xls"
email "Gasto de materiales. Grupo2.", Array("correo1@vbatotal.com", "correo2@vbatotal.com"), "C:\Grupo2.xls"
email "Gasto de materiales. Grupo3.", Array("correo1@vbatotal.com", "correo3@vbatotal.com"), "C:\Grupo3.xls"
'Activamos el refresco de pantalla
Application.ScreenUpdating = True
End Sub
Si miramos el cuadro de arriba, con el primer comando, por ejemplo, enviaremos un correo con el asunto “Gasto de materiales. Grupo 1” al destinatario “correo1@vbatotal.com” con el archivo adjunto ubicado en “C:\Grupo1.xls”.
Una vez dimensionamos las variables que vamos a utilizar, iniciamos sesión en Lotus,
'Función para el envío automático de correos
Dim Maildb As Object
Dim mailDoc As Object
Dim body As Object
Dim session As Object
'Iniciamos la sesión en Lotus
Set session = CreateObject("Notes.NotesSession")
y abrimos la base de datos si es que no lo está ya.
Set Maildb = session.GetDatabase("", "names.nsf")
If Not Maildb.IsOpen = True Then
Call Maildb.Open
End If
A continuación, creamos un nuevo correo.
Set mailDoc = Maildb.CreateDocument
Call mailDoc.ReplaceItemValue("Form", "Memo")
Los correos destinatarios han sido definidos a la hora de llamar a la función, y lo que hacemos es copiarlos en el apartado “sendTo” del nuevo correo creado.
Call mailDoc.ReplaceItemValue("SendTo", Recipient)
Con el asunto del correo pasa lo mismo porque ya está definido a la hora de llamar a la función y lo pasa al apartado correspondiente del nuevo correo.
Call mailDoc.ReplaceItemValue("Subject", Subject)
Sin embargo, el cuerpo del correo si hay que introducirlo aquí, y no es más que el mensaje que queremos transmitir. En este caso “Buenos días, adjunto archivo con los gastos de materiales. Saludos”
Set body = mailDoc.CreateRichTextItem("Body")
Call body.AppendText("Buenos días,")
Call body.AddNewLine(2)
Call body.AppendText("Adjunto archivo con los gastos de materiales.")
Call body.AddNewLine(2)
Call body.AppendText("Saludos.")
El comando Call body.AddNewLine(2) hace tantos saltos de renglón como número indicamos entre paréntesis. En este caso dos.
Llegamos al apartado de adjuntos. También los definimos al llamar a la función, así que simplemente los introduce en el apartado correspondiente del nuevo correo.
Call body.AddNewLine(4)
Call body.EmbedObject(1454, "", Attachment)
Call body.AddNewLine(2)
Por último, introducimos en el pie de correo la frase “Este es un correo automático.” y ya lo tenemos listo. Solo nos quedaría ejecutar la macro pulsando el botón, para enviar el email desde Excel.
Call body.AddNewLine(2)
Call body.AppendText("Este es un correo automático.")
Una vez cumplimentados todos los campos, realizamos el envío del mismo y limpiamos por si queremos enviar otro.
Call mailDoc.ReplaceItemValue("PostedDate", Now())
Call mailDoc.send(False)
'Limpiamos
Set Maildb = Nothing
Set mailDoc = Nothing
Set body = Nothing
Set session = Nothing
End Sub
Con esto llegamos al final de la vigésimo octava lección, en la que has aprendido cómo enviar un informe por email de manera automática desde Microsoft Excel utilizando una macro.
Por último, quiero invitarte a compartir tus dudas en los comentarios o en el foro. Intentaré ayudarte en todo lo que pueda, y así aprenderemos todos.
Nos vemos en el próximo capítulo.
Si te ha servido y quieres donar
Descarga el archivo del ejemplo
2 Comentarios
Enviar un comentario
« EP7. Cómo usar Change e Intersect en macros.
EP9. Cómo imprimir informes con macros. »
Hola Raúl. No he entendido bien qué es exactamente lo que quieres incluir en el cuerpo del email. Te agradecería que me pusieses un ejemplo. Saludos.
Me gustaría saber como puedo pegar en el contenido del correo el print de algunos reportes propios del archivo adjunto.