por Hola a todos!:
Parece que este 2019 ya se va apagando poco a poco!. Y en breve estaremos iniciando el 2020. Espero que todo nos vaya muy bien y se cumplan nuestros sueños y proyecto.
Mientras tanto, voy a escribir un post como respuesta a una consulta:
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? Gracias
Esta consulta viene como referencia a un post inicial en el que programé un procedimiento automático de envío de archivos según los tengamos detallados en nuestra hoja Excel. Este es el post: SELECCIONAR ARCHIVOS DE UNA CARPETA Y ENVIARLOS POR OUTLOOK SEGÚN CATÁLOGO DE INFORMES
En este caso, lo que el lector solicita es que el código recorra todas las carpetas y cuando se encuentra con las que hemos indicado, adjunte en para cada nombre/carpeta todo el contenido de la misma en el correo de outlook.
Vamos a aprovechar la macro del proceso anterior y modificar algunas rutinas para realice lo que necesitamos:
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.
Set olApp = CreateObject("Outlook.Application")
Set olMail = olApp.CreateItem(olMailItem)
'Recorremos todas las carpetas y subcarpetas
For Each subcarpeta In nCarpeta.SubFolders
CARPETA subcarpeta
Next subcarpeta
For i = 2 To fin
'Si la carpeta se llama igual a la que tenemos en la hoja
'Adjuntamos todo su contenido
If .Cells(i, 1) = nCarpeta.Name Then
For Each File In nCarpeta.Files
adjunto = File
nFile = Left(File.Name, InStr(File.Name, ".") - 1)
'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
Next File
End If
Next i
olMail: Close
olApp: Close
End With
Set olMail = Nothing
Set olApp = Nothing
End Function
A diferencia del post anterior, en este caso vamos a recorrer todas las carpetas y subcarpetas hasta encontrar la que coincida con la hemos especificado en la hoja. En el momento que lo haga adjuntaremos todos los archivos a Outlook.
Por ejemplo, si elijo uno de mis post (donde guardo todos los archivos con los que escribo la entrada, imágenes, excel, etc):
Y esta sería la carpeta:
Con un total de 6 archivos que tendríamos que adjuntar. Si ejecutamos la macro y seleccionamos la carpeta en la que se encuentran los datos, generaremos el siguiente email:
Como podéis observar, aquí tenemos el correo con todos los adjuntos de la carpeta que hemos indicado.
Y esta ha sido la contestación a la consulta, espero que también a vosotros os sea de utilidad para vuestros procedimientos de envío.
Descarga el archivo de ejemplo pulsando en: SELECCIONAR ARCHIVOS DE UNA CARPETA Y ENVIARLOS POR OUTLOOK SEGÚN EL NOMBRE DE LA CARPETA
¿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
