A continuación vamos a explicar como mediante una macro podemos generar emails, adjuntar archivos y mandarlos a través de Outlook. Para ello hemos creado tres ejemplos de dificultad creciente. En el primer ejemplo vamos a mandar un email con solo texto, en el segundo ejemplo vamos a añadir archivos adjuntos a este email y en el tercer ejemplo vamos a crear un excel donde poder escribir 5 emails de manera simultánea, adjuntar archivos y despues mandarlos todos de una sola vez.
Ejemplo 1: Mandar un email con solo texto
En primer lugar y tal como explicamos en el artículo de exportar tablas a Power Point tenemos que activar la libreria de Microsoft Outlook (Microsoft Outlook 15.0 Object Library).
Activar Librería
Para activar la librería tenemos que ir a Herramientas>>Referencias. En la nueva ventana que se nos abre tenemos que activar la Librería de Objetos de Outlook (La versión depende del Office instalado, en nuestro ejemplo es la version 15.0)
Una vez activada esta librería podremos usar en nuestro código objetos de Outlook.
Código para mandar email con VBA
Para mandar un email los campos qué necesitamos rellenar son el de destinatario, direcciones en copia y contenido del email. El código completo es el siguiente:
Sub enviarcorreo()
Dim i, j As Integer
Dim pagina1 As Worksheet
Set pagina1 = ActiveWorkbook.Worksheets("Ejemplo1")
Dim OutApp As Object
Dim Correo As Object
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
'Comprobar si Outlook esta abierto y en caso de no estarlo abrirlo
On Error Resume Next
Set OutApp = GetObject("", "Outlook.Application")
Err.Clear
If OutApp Is Nothing Then Set OutApp = CreateObject("Outlook.Application")
OutApp.Visible = True
Set Correo = OutApp.CreateItem(0)
'Crear el correo y mostrarlo
With Correo
.To = pagina1.Range("C8").value
.CC = pagina1.Range("C9").value
.Subject = pagina1.Range("C10").value
.HTMLBody = pagina1.Range("C11").value
.Display
End With
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub
En este primer ejemplo como siempre hemos definido primero nuestra variables. En este caso hemos creado la variable “pagina1” y le hemos asignado la hoja “Ejemplo1”. De esta manera nos ahorraremos un poco de código posteriormente.
A continuación desactivamos EnableEvents (típicas ventanitas que aperecen con “¿Está seguro de que…?”) y también ScreenUpdating (es decir, que la pantalla solo se actualice una vez haya terminado la macro).
Después comprobamos si Outlook está abierto. La manera de comprobarlo es mediante prueba y error; vamos a intentar seleccionarlo (“GetObject”) y si nos da error, eso quiere decir que no está abierto. En ese caso lo abriremos mediante “CreateObject”.
Para crear un correo hemos usando el comando “OutApp.CreateItem(0)”. El número entre paréntesis hace referencia al objecto que vamos a crear. En este caso es un email. Otros números que podemos usar son:
- CreateItem(1) = Cita
- CreateItem(2) = Contacto
- CreateItem(3) = Tarea
- CreateItem(4) = Entrada del diario
- CreateItem(5) = Nota
- CreateItem(6) = Discusión
- CreateItem(7) = Grupo de contactos
Por último al correo le vamos a asignar un destinatario que hemos escrito en la celda “C7”, un correo en copia que está en la celda “C8”, un asunto que está en la celda “C9” y un contenido que está en la celda “C10”.
Con el comando “.Display” vamos amostrar el email en pantalla pero no se va a mandar. Si queremos que Outlook mande el email de manera automática tenemos que sustituir “.Display” por el comando “.Send”.
Al final del código volvemos a activar EnableEvents y ScreenUpdating.
Ejemplo 2 Mandar un email con archivos adjuntos
Este ejemplo es una modificación del anterior. Vamos a crear un email de la misma manera que en el Ejemplo 1 pero esta vez le vamos a añadir un archivo adjunto al email.
Para añadir un archivo adjunto hemos creado una segunda macro. La nueva macro se puede escribir en el mismo módulo a continuación de la macro del ejemplo anterior o en otro módulo diferente.
Mediante esta nueva macro vamos a abrir una ventana de diálogo para poder seleccionar los archivos que queremos adjuntar. Una vez seleccionados escribiremos la dirección de los archivos seleccionados en las celdas “C10:C19” (vamos a limitar a 10 el máximo número de archivos a adjuntar). También vamos a crear un hyperlink a estos archivos adjuntados para poder abrir rápidamente los archivos que estamos adjuntando.
Código para adjuntar archivos a email
Sub seleccionararchivosadjuntos()
Dim i As Integer
Dim numeroArchivos As Integer
Dim pagina2 As Worksheet
Set pagina2 = ActiveWorkbook.Worksheets("Ejemplo2")
Dim fldr As FileDialog
Set fldr = Application.FileDialog(msoFileDialogFilePicker)
'determinar cuantos archivos adjuntos hay
numeroArchivos = 0
For i = 1 To 10
If pagina2.Cells(10 + i, 3) <> "" Then
numeroArchivos = numeroArchivos + 1
End If
Next i
'preguntar si desea borrar los archivos ya adjuntados (en caso de que los haya)
If numeroArchivos <> 0 Then
If MsgBox("¿Desea borrar los archivos adjuntados existentes?", vbYesNo) = vbYes Then
ActiveWorkbook.Worksheets("Sheet2").Range("F18:F27").ClearContents
End If
End If
'mostrar ventana con archivos a elegir
With fldr
.Title = "Select a Folder"
.AllowMultiSelect = True
If .Show <> -1 Then Exit Sub
If .SelectedItems.Count > 10 - numeroArchivos Then
MsgBox "Sólo puede adjuntar 10 archivos cómo máximo"
Exit Sub
End If
'escribir los archivos en el excel y asignarles un hyperlink
If .SelectedItems.Count <= 10 Then
For i = 1 To .SelectedItems.Count
pagina2.Cells(10 + i + numeroArchivos, 3) = .SelectedItems(i)
pagina2.Cells(10 + i + numeroArchivos, 3).Worksheet.Hyperlinks.Add _
anchor:=pagina2.Cells(10 + i + numeroArchivos, 3), _
Address:=.SelectedItems(i), _
TextToDisplay:=.SelectedItems(i)
Next i
End If
End With
End Sub
A continuación vamos a crear un botón al que asignaremos esta macro. La primera parte del código lo que hace es que cuando hagamos clic en el botón compruebe si ya hay algun archivo adjunto. En caso de que existan archivos adjuntos nos preguntará si queremos eliminarlos o si simplemente queremos añadir más archivos adjuntos a los ya existentes. Si no los eliminamos, contará cuantos archivos ya están adjuntados y nos permitirá añadir más archivos hasta un total de 10.
Después copiará los normbres de los archivos en una lista y asignará un hyperlink a su contenido.
Código para eliminar archivos adjuntos
Además vamos a crear otro botón que nos permita eliminar todos los archivos adjuntos a la vez. El código para eliminarlos es el siguiente:
Sub eliminararchivosadjuntos()
Dim pagina2 As Worksheet
Set pagina2 = ActiveWorkbook.Worksheets("Ejemplo2")
pagina2.Range("C11:C20").ClearContents
End Sub
Código para mandar email con archivos adjuntos
Ahora vamos a modificar la macro del primer ejemplo para que añada los archivos adjuntos seleccionados:
Sub enviarcorreo()
Dim i, j As Integer
Dim pagina2 As Worksheet
Set pagina2 = ActiveWorkbook.Worksheets("Ejemplo2")
Dim OutApp As Object
Dim Correo As Object
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
'Comprobar si Outlook esta abierto y en caso de no estarlo abrirlo
On Error Resume Next
Set OutApp = GetObject("", "Outlook.Application")
Err.Clear
If OutApp Is Nothing Then Set OutApp = CreateObject("Outlook.Application")
OutApp.Visible = True
Set Correo = OutApp.CreateItem(0)
'Contar el numero de archivos adjuntos
Dim numeroArchivos As Integer
numeroArchivos = 0
Do While hoja.Cells(11 + numeroArchivos, 3) <> ""
numeroArchivos = numeroArchivos + 1
Loop
'Crear el correo y mostrarlo
With Correo
.To = hoja.Range("C7").value
.CC = hoja.Range("C8").value
.Subject = hoja.Range("C9").value
.HTMLBody = hoja.Range("C10").value
For i = 1 To numeroArchivos
.Attachments.Add (hoja.Cells(10 + i, 3).Value)
Next i
.Display
End With
End Sub
Ejemplo 3: Mandar 5 emails con Excel de manera simultánea
Este ejemplo es simplemente una variación de los ejemplos ateriores que introduce varios bucles y que nos permite crear 5 emails para despues mandarlos de una sola vez.
Creación de controles ActiveX
Ahora vamos a tener 5 botones diferentes para adjuntar archivos y 5 botones para eliminarlos, cada uno de ellos haciendo referencia a un email diferente. Para solucionar este problema lo que hemos hecho ha sido crear controles ActiveX como se muestra en la imagen a continuación. Para añadirlo tenemos que ir a la pestaña de Desarrolador >> Insertar.
De una manera simple y breve podríamos decir que la diferencia entre los controles de formulario y los controles ActiveX es que los primeros ejecutan una macro escrita en un módulo mientras que lo segundos se les puede asignar su propio código que solo se encuentra asociado a ese botón en particular.
Una vez hayamos creado el control ActiveX lo podremos seleccionar en VBE en la hoja en que lo hayamos colocado.
En la parte superior derecha en la pestaña desplegable podemos seleccionar cual es el evento que ejecute el código asociado a este botón.
En nuestro caso hemos seleccionado el evento “hacer click en el botón”.
Ahora vamos a crear una variable global que va a ser el email al que correponde el control. Vamos a crear dos botones asociados a cada email. El primer boton para adjuntar archivos y el Segundo para eliminar todos los archivos adjuntos. Cuando hagamos click en un control asignarmos el número de columna del email a la variable global y esta variable será pasada a la macro que permite seleccionar ó eliminar los archivos adjuntos. En función de la variable que le hayamos pasado a la macro esta escribirá los archivos seleccionados en una columna o en otra.
El código de los controles ActiveX es el siguiente:
Option Explicit Public nocolumna As Integer Private Sub CommandButton1_Click() nocolumna = 3 Call seleccionararchivosadjuntos3(nocolumna) End Sub Private Sub CommandButton2_Click() nocolumna = 3 Call eliminararchivosadjuntos3(nocolumna) End Sub Private Sub CommandButton3_Click() nocolumna = 6 Call seleccionararchivosadjuntos3(nocolumna) End Sub Private Sub CommandButton4_Click() nocolumna = 6 Call eliminararchivosadjuntos3(nocolumna) End Sub Private Sub CommandButton5_Click() nocolumna = 9 Call seleccionararchivosadjuntos3(nocolumna) End Sub Private Sub CommandButton6_Click() nocolumna = 9 Call eliminararchivosadjuntos3(nocolumna) End Sub Private Sub CommandButton7_Click() nocolumna = 12 Call seleccionararchivosadjuntos3(nocolumna) End Sub Private Sub CommandButton8_Click() nocolumna = 12 Call eliminararchivosadjuntos3(nocolumna) End Sub Private Sub CommandButton9_Click() nocolumna = 15 Call seleccionararchivosadjuntos3(nocolumna) End Sub Private Sub CommandButton10_Click() nocolumna = 15 Call eliminararchivosadjuntos3(nocolumna) End Sub
Adjunar archivos a los diferentes emails
Ahora vamos a modificar el código mostrado en el Ejemplo 2 para que ahora tome una variable de entrada y sea capaz de adjuntar archivos a cada email de manera individual.
El código completo es el siguiente:
Sub seleccionararchivosadjuntos3(nocolumna As Integer)
Application.ScreenUpdating = False
Dim i, j As Integer
Dim numeroArchivos As Integer
Dim hoja As Worksheet
Set hoja = ActiveWorkbook.Worksheets("Ejemplo3")
Dim fldr As FileDialog
Set fldr = Application.FileDialog(msoFileDialogFilePicker)
'determinar cuantos archivos adjuntos hay
numeroArchivos = 0
Do While hoja.Cells(12 + numeroArchivos, nocolumna) <> ""
numeroArchivos = numeroArchivos + 1
Loop
'preguntar si desea borrar los archivos ya adjuntados (en caso de que los haya)
If numeroArchivos <> 0 Then
If MsgBox("¿Desea borrar los archivos adjuntados existentes?", vbYesNo) = vbYes Then
hoja.Cells(12, nocolumna).Resize(10, 1).ClearContents
End If
End If
'mostrar ventana con archivos a elegir
With fldr
.Title = "Select a Folder"
.AllowMultiSelect = True
If .Show <> -1 Then Exit Sub
If .SelectedItems.Count > 10 - numeroArchivos Then
MsgBox "Sólo puede adjuntar 10 archivos cómo máximo"
Exit Sub
End If
'escribir los archivos en el excel y asignarles un hyperlink
If .SelectedItems.Count <= 10 - numeroArchivos Then
For i = 1 To .SelectedItems.Count
hoja.Cells(11 + numeroArchivos + i, nocolumna).Worksheet.Hyperlinks.Add _
anchor:=hoja.Cells(11 + numeroArchivos + i, nocolumna), _
Address:=.SelectedItems(i), _
TextToDisplay:=.SelectedItems(i)
Next i
End If
End With
Application.ScreenUpdating = True
End Sub
Eliminar los archivos adjuntos de los diferentes emails
Para eliminar los archivos adjuntados al igual que en el código mostrado arriba vamos a tomar una variable de entrada (dependiendo del botón que se haya seleccionado) y eliminaremos los archivos adjuntos correspondientes.
Sub eliminararchivosadjuntos3(nocolumna As Integer)
Dim hoja As Worksheet
Set hoja = ActiveWorkbook.Worksheets("Ejemplo3")
Range(hoja.Cells(12, nocolumna), hoja.Cells(21, nocolumna)).ClearContents
End Sub
Enviar todos los correos de manera simultánea
Sub enviarcorreo3()
Dim i, j, k As Integer
Dim hoja As Worksheet
Set hoja = ActiveWorkbook.Worksheets("Ejemplo3")
Dim OutApp As Object
Dim Correo As Object
Dim numeroArchivos As Integer
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
'Comprobar si Outlook esta abierto y en caso de no estarlo abrirlo
On Error Resume Next
Set OutApp = GetObject("", "Outlook.Application")
Err.Clear
If OutApp Is Nothing Then Set OutApp = CreateObject("Outlook.Application")
OutApp.Visible = True
For k = 1 To 5
Set Correo = OutApp.CreateItem(0)
'Contar el numero de archivos adjuntos
numeroArchivos = 0
Do While hoja.Cells(12 + numeroArchivos, k * 3) <> ""
numeroArchivos = numeroArchivos + 1
Loop
'Crear el correo y mostrarlo
With Correo
.To = hoja.Cells(8, k * 3)
.CC = hoja.Cells(9, k * 3)
.Subject = hoja.Cells(10, k * 3)
.HTMLBody = hoja.Cells(11, k * 3)
For i = 1 To numeroArchivos
.Attachments.Add (hoja.Cells(11 + i, k * 3).Value)
Next i
.Display
End With
seguir:
Next k
End Sub
Bonus track: Descarga estos ejemplos
Ya se que estos ejemplos son muy golosos. Por eso te los dejo aquí para que te los puedas descargar y probar tú tranquilamente en tú ordenador.
[sociallocker]
[/sociallocker]