Macro para enviar emails usando Outlook

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”.

mandar email con excel

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]

Enviar un email con VBA

[/sociallocker]

 

(Visited 228.966 times, 1 visits today)
Categorías VBA

Uso de cookies

Este sitio web utiliza cookies para que usted tenga la mejor experiencia de usuario. Si continúa navegando está dando su consentimiento para la aceptación de las mencionadas cookies y la aceptación de nuestra política de cookies, pinche el enlace para mayor información ACEPTAR

Aviso de cookies