por Hola a todos!.
El envío de correos a través de Outlook utilizando VBA es un tema muy visto en manuales, web etc … que se dedican a Excel.
Como ya sabéis, trato de no publicar temas sobre los que la información existente ya es muy abundante. Principalmente porque no aportaría nada nuevo y por otra parte porque así me obligo a buscar alternativas y publicar cosas nuevas o poco publicadas.
En este caso, lo que os propongo es realizar un pequeño proceso mediante el cual vamos a detallar en una hoja una relación de nombres de archivos que normalmente enviamos a nuestros clientes y que luego vamos a seleccionar de la carpeta en la que se encuentran para finalmente enviarlos por Outlook.
Imaginad que tenemos una carpeta con una serie de informes:
Y queremos que seleccionando la carpeta EJEMPLOS se adjunten y se envíen por correo Outlook. Esto lo vamos a especificar de la siguiente manera en nuestro archivo Excel:
Como véis debemos indicar el nombre del archivo EXACTAMENTE igual que el que tenemos en la carpeta y sin la extensión.
Una vez que lo tenemos, ejecutaremos el siguiente código, compuesto por una macro que ejecuta una función:
Sub ENVIAR_CORREOS()
'Declaramos variables
Dim sFSO As Object, Directorio As String
Dim dir_Archivo As Variant
'Abrimos ventana de diálogo para seleccionar carpeta
Set dir_Archivo = Application.FileDialog(msoFileDialogFolderPicker)
dir_Archivo.Show
'Si no seleccionamos nada salimos del proceso
If dir_Archivo.SelectedItems.Count = 0 Then
Exit Sub
End If
'Capturamos el directorio
Directorio = dir_Archivo.SelectedItems(1)
'Creamos objeto y ejecutamos función Carpeta
Set sFSO = CreateObject("Scripting.FileSystemObject")
CARPETA sFSO.GetFolder(Directorio)
End Sub
Function CARPETA(ByVal nCarpeta)
'Declaramos variables
Dim olApp As Outlook.Application
Dim olMail As Outlook.MailItem
Dim fin As Long, i As Long, File As Variant
Dim adjunto As String, nFile As String
Dim olMailItem As Variant, Celda As Variant
'Iniciamos función
With Sheets("Hoja1")
fin = Application.CountA(.Range("A:A"))
'recorremos hoja y celda para comprobar si hace
'referencia a varios archivos.
For i = 2 To fin
Set olApp = CreateObject("Outlook.Application")
Set olMail = olApp.CreateItem(olMailItem)
For Each Celda In Split(.Cells(i, 1), "|")
For Each File In nCarpeta.Files
adjunto = File
nFile = Left(File.Name, InStr(File.Name, ".") - 1)
If Celda = nFile Then
'Destinatario
olMail.To = .Cells(i, 2)
'Con copia a
olMail.CC = .Cells(i, 3)
'Con copia oculta
olMail.BCC = .Cells(i, 4)
'Asunto
olMail.Subject = .Cells(i, 1)
'Cuerpo de correo
olMail.HTMLBody = "Buenos días:
Les enviamos los archivos solicitados.
Atentamente."
' Adjuntamos archivo y dejamos correo en bandeja de salida
olMail.Attachments.Add (adjunto)
'Para enviar debéis utilizar Send en lugar de Display
'olMail.Send
olMail.Display
End If
Next File
Next Celda
olMail: Close
olApp: Close
Next i
End With
Set olMail = Nothing
Set olApp = Nothing
End Function
La macro principal selecciona la carpeta y la función recorre todos los archivos que contiene. En el momento que el archivo de la instrucción for-each es igual al archivo especificado en la hoja, procedemos a realizar el envío con Outlook.
Dado que tenemos también el correo del destinatario, con copia (CC) y con copia oculta (CCO) en la misma línea, podemos indicarlo en la macro para que los incluya.
Si queremos enviar a varios destinatarios a la vez, solo tenéis que indicar el correo electrónico seguido de un punto y como «;» y luego el siguiente email (como lo hacéis en Outlook).
Si lo que queréis es adjuntar varios archivos en un correo, debéis utilizar la barra como delimitador la barra vertical «|». Por ejemplo en la siguiente imagen, el primer correo adjuntará los archivos «EJEMPLO» y «EJEMPLO_2»:
El resultado es el siguiente, los tres correos han sido generados y cada uno con su adjunto:
En el ejemplo de la macro los dejo en bandeja de salida, si queréis enviarlos directamente, debéis sustituir: olMail.Display por olMail.Send
Y eso es todo! Espero que os haya resultado de interés.
Descarga el archivo de ejemplo pulsando en: SELECCIONAR ARCHIVOS DE UNA CARPETA Y ENVIARLOS POR OUTLOOK SEGÚN CATÁLOGO DE INFORMES
¿Te ha resultado de interés?, puedes apoyar a Excel Signum con una pequeña donación.
¡¡Muchas gracias!!
Mediante la suscripción al blog, la realización comentarios o el uso del formulario de contacto estás dando tu consentimiento expreso al tratamiento de los datos personales proporcionados según lo dispuesto en la ley vigente (LOPD). Tienes más información al respecto en esta página del blog: Política de Privacidad y Cookies
Muy bueno, como siempre.
Solo una duda, que pasa si la carpeta esta en una red compartida?
gracias¡¡
a lo que me refiero es, al abrir el cuadro de dialogo para escoger el archivo, como puedo poner que por defecto me abra una carpeta que esta en una red compartida? asi evitar el tener que ir recorriendo toda la ruta hasta donde esta el fichero a enviar.
Recuerda que la carpeta esta en red y no en mi pc, siendo en mi pc es sencillo fijar que por defecto abra una ruta especificada.
muchas gracias
Hola Lucas:
Es sencillo, eliminas la parte que hace referencia a la selección y lo compones así (la macro), la función queda como está.
Es igual que se trate de una carpeta en red, solo tienes que indicar la ruta
Sub ENVIAR_CORREOS()'Declaramos variables
Dim sFSO As Object, Directorio As String
Dim dir_Archivo As Variant
'INDICAMOS RUTA CARPETA
dir_Archivo = "C:\Users\USUARIO\CARPETA"
'Creamos objeto y ejecutamos función Carpeta
Set sFSO = CreateObject("Scripting.FileSystemObject")
CARPETA sFSO.GetFolder(dir_Archivo)
End Sub
Saludos
muchas gracias por tus aportes, bien explicados y muy utiles
Habria posibilidad de elegir la cuenta de correo desde la que lo quieres mandar?, en el caso de que tengas mas de una
Hola Barman:
La macro se ejecuta con la cuenta con la que hayas iniciado outlook.
Saludos
Hola Segu, una duda, necesito hacer estos envios, pero en lugar de tener el nombre de los aduntos, lo que tengo es el nombre de las carpetas. Mi macro debe recorrer esos nombres, ir abriendo cada carpeta y adjuntando para cada persona todos los archivos que contengan esas rutas.
Es decir, para el destinatario «MANUEL» tengo que ir a la carpeta en ruta que se llame Manuel y enviar en un correo todos los archivos contenidos en esa ruta..
No consigo que me adjunte los archivos..
¿Puedes ayudarme? Garcias
Hola Álvaro: estoy de vacaciones estos días y no voy a programar. En cuando las finalice trato de ayudarte. Saludos
Saludos tu post es muy interesante, pero tengo algunos problemas, cuando en el excel separo los archivos que voy adjuntar por ejemplo archivo1|archivo2 si utilizo olMail.Display el me muestra los archivos adjuntos, claro que el segundo archivo demora un segundo en cargar, pero si utilizo olMail.Send me manda un error diciendo que “este item ha sido movido o borrado” y me muestra la linea de la macro olMail.To = .Cells(i, 2), creo yo que es por el retrazo de cargar el segundo archivo, pero igual con el errror envía el primer adjunto descartando el segundo, y ya revisé que los archivos tengan correctamente el nombre.
me pasa lo mismo al querer enviar dos archivos con el mismo nombre pero diferente extensión, me marca el error “este item ha sido movido o borrado” y me muestra la linea de la macro olMail.To = .Cells(i, 2), alguna sugerencia
Esa línea hace referencia al destinatario del correo, no a los archivos adjuntos, por favor, comprueba ese dato.
Saludos
Hola Emiro:
Intenta con un Do events antes de que se realice el envío o Application.Wait(Now + TimeValue(«0:00:3»)) tres segundo de espera.
Saludos.