Saltar al contenido

VBScript – Guardar los Archivos Adjuntos en Carpetas Especificas Automáticamente Outlook

El siguiente VBScript crea una carpeta con el nombre del Asunto (Subject) y guarda los archivos adjuntos que contiene el correo automáticamente.

Instrucciones de Uso

1.- Abrir el editor de Visual Basic (ALT+F11).

2.- Insertar un modulo nuevo (Insert > Module).

3.- Copiar el código VBScript.

4.- En la linea 7 debemos especificar la ruta donde se guardaran los archivos.

Para mas información de configuración ver: Como utilizar el Editor VBA en Office (Utilizar Macros VBScript) y Outlook – Crear y configurar reglas

Código

Public Sub saveAttachToSpecificFolder(itm As Outlook.MailItem)
Dim objAtt As Outlook.Attachment
Dim saveFolder As String
Dim getSubject As String
Dim dDate As Date

destinationFolder = "C:\1-Tests\"
getSubject = itm.Subject
dDate = itm.ReceivedTime
ReplaceIllegalChars getSubject, "-"
saveFolder = destinationFolder & Format(dDate, "yyyy-mm-dd") & Format(dDate, "-hhnnss") & "-" & getSubject

'Objeto crear folder
Set fso = CreateObject("Scripting.FileSystemObject")
' Crear Folder
If Not fso.FolderExists(saveFolder) Then
Set objFolder = fso.Createfolder(saveFolder)
End If
 
     For Each objAtt In itm.Attachments
          objAtt.SaveAsFile saveFolder & "\" & objAtt.DisplayName
          Set objAtt = Nothing
     Next
End Sub
  
Private Sub ReplaceIllegalChars(getSubject As String, _
  sChr As String _
)
  getSubject = Replace(getSubject, "/", sChr)
  getSubject = Replace(getSubject, "\", sChr)
  getSubject = Replace(getSubject, ":", sChr)
  getSubject = Replace(getSubject, "?", sChr)
  getSubject = Replace(getSubject, Chr(34), sChr)
  getSubject = Replace(getSubject, "<", sChr)
  getSubject = Replace(getSubject, ">", sChr)
  getSubject = Replace(getSubject, "|", sChr)
  getSubject = Replace(getSubject, "*", sChr)
End Sub

 

Entradas relacionadas

Deja un comentario

Tu dirección de correo electrónico no será publicada. Los campos obligatorios están marcados con *

Este sitio usa Akismet para reducir el spam. Aprende cómo se procesan los datos de tus comentarios.

Comentarios (19)

Hola!

Mil gracias por colaborarme con esta solicitud, el script funciona perfecto y ya no tengo ningún inconveniente con los correos reenviados, detecte que me seria muy útil que cada carpeta tuviera la fecha antes del asunto del correo pero soy muy nueva utilizando VB y aun no he podido, agradecería mucho tu ayuda para obtener en las carpetas algo así ” 20 05 2016 – asunto del mensaje”, Te comento que ya compartí el articulo en G+, es muy útil.

Responder

Buen dia!
Se realizo una modificación en las lineas 5 y 11 para agregar la configuración que deseas, en base a esto podridas manipular a tus necesidades cambiar los – por algun otro caracter aceptado, por el momento lo visualizaras 2016-05-20-122930 que es Año-Mes-Dia-horaminutosegundo.

Muchas gracias por compartir el articulo.

Nos comentas los resultados.

Responder

Hola!

Mil gracias…la macro me funciona de maravilla y me ha facilitado mucho el trabajo.

Un saludo.

Responder

como le hago para que en vez de que me aparezca el asunto me de el remitente

Responder

Buen dia Jonothan

Cambia itm.Subject por itm.senderName, de igual forma puedes renombrar el nombre de la variable getSubject por getSender o getFrom es opcional.

Saludos.

Responder

Estimado Fernando, esta vez no te realizo consulta alguna, solo escribo esta lineas para desearte que estos dias de Diceimbre aparte de tener tabajo, tengas salud y felicidad con los tuyos, mis mejores deseos y que sigas asi con tu blog ya que seguido me doy una vuelta por aqui.

Feliz Año 2017.

Atte.

Humberto Morales

Responder

Buen dia Humberto

Igualmente que tengas felices fiestas y un excelente 2017.

Muchas gracias por los buenos deseos y seguir a Portal+Tips.

Esperamos seguir escuchando de ti en Portal+Tips.

Saludos.

Responder

esta muy bien esta idea y me sirve , solo que me genera la carpeta sin contenido y aparte me genera el archivo adjunto y tengo que estar borrando las carpetas para dejar los adjuntos solamente

Responder

Buen dia

Quizas te sea de mas utilidad los scripts del siguiente articulo VBScript para guardar automáticamente archivos adjuntos Outlook, no crean carpetas solo descargan los archivos a una carpeta especificada en el codigo.

Excelente dia.

Responder

Muchas gracias , muy buenos los códigos! Me han ahorrado mucho tiempo en la oficina.

Responder

Excelente David, Me alegra leerlo.

Responder

Y EN QUE MOMENOT SE EJECUTA O COMO SE EJECUTA EL SCRIPT

Responder

Buen dia Jose

Estos los envias a ejecutar creando reglas en outlook, puede revisar mas informacion en Crear y configurar reglas

Saludos.

Responder

Hola amigo, he estado leyendo y buscando entre respuestas que has dado a todos y es muy bueno toda esa ayuda.
Ojalá pudieras ayudarme, la idea es que los correos que lleguen entren a una carpeta en el correo y descargue los adjuntos ( fotos) en una carpeta en (C:). tengo el script crear una carpeta y descargar automáticamente que has publicado, la regla funciona tiene vinculado el script y este me genera la carpeta en la ruta que quiero pero el problema es que no descarga los adjuntos que serian fotos.
Por favor podrías ayudarme, recibo mucho correo con adjuntos y tengo q hacer este proceso con cada uno.

Muchas gracias

Responder

Buen dia Carlos

Puedes adjuntar el código de tu script tal cual lo tienes configurado.

Excelente día.

Responder

Hola Buenos días

Excelente Portal y es de muchisima ayuda para los usuarios en hora buena por tu portal.

Tengo una Duda y me gustaria que me ayudaras por favor.

Evisto el Script que hace la importacion de un archivo adjunto a una carpeta especifica… ahora, mi pregunta es la siguiente:

Se puede agregar un IF para que compruebe si el nombre del archivo tiene cierto nombre y si tiene ese nombre guardarlo en cierta carpeta y si no en otra?

Soy consciente de que esa eleccion se puede hacer con la regla misma del Outlook, pero me gustaria que esa eleccion haga el Script… eso es posible?

Gracias por su respuesta.

Responder

Buen dia Richard

Si es posible.

La parte de la condición seria
If InStr(UCase(objAtt.DisplayName), \".XML\") Then
For Each objAtt In itm.Attachments
objAtt.SaveAsFile saveFolder & \"\" & objAtt.DisplayName
Set objAtt = Nothing
Next
Else
For Each objAtt In itm.Attachments
objAtt.SaveAsFile saveFolder2 & \"\" & objAtt.DisplayName
Set objAtt = Nothing
Next
End If

Solo declara otra variable y la ruta en saveFolder2

Excelente dia

Responder

Hola, he utilizado el script que crea una carpeta con el nombre de asunto y guarda dentro los asuntos, funciona perfectamente, pero necesito que borre la bandeja de entrada para que no se me acumulen los correos y al mismo tiempo saber si es posible hacer que los adjuntos que son fotos pueden bajar su peso a unos 100k muchas gracias de antemano

Responder

Buen dia Ruben

En las reglas de Outlook te permite indicar que envíe a eliminados los correos procesados por la regla.
Respecto bajar su peso se puede reduciendo el tamaño en porcentaje se pierde calidad en la imagen y no reduce el peso significativamente ya que en si solo es jugar con el Zoom Outlook no incluye forma de usar procesador de imágenes; quizás alguna API externa que envíe las imágenes las procese y las inserte nuevamente; si te interesa esto contactame en el formulario asi investigo y te cotizo el proyecto.

Excelente dia.

Responder
Leer entrada anterior
Instalar Herramientas de administración remota de servidor para Windows 10
Instalar Herramientas de administración remota de servidor para Windows 10

Cuando se administran redes y servidores se requieren ciertas utilidades como Server Manager, MMC, DHCP, IPAM, Routing and Remote Access...

Cerrar