domingo, 21 de octubre de 2012

OUTLOOK 2007 CREACIÓN DE MACRO PARA SALVAR ARCHIVOS ADJUNTOS

Vamos a crear una macro que salve a una carpeta específica todos los archivos adjunto de un mensaje o de varios mensajes sin necesidad de abrirlos.

Editor de Visual Basic

media_1350843949827.png
Abrimos el editor pulsando ALT+F11.

Ventana de proyectos

media_1350844005939.png
A la izquierda tenemos la ventana de proyectos. Hacemos doble clic en ThisOutlookSession.

Pegado de código

media_1350844367377.png
En la sección de edición pegamos el código que se reproduce abajo en azul. La macro se llamará SavenotdeleteAttachments (no elimina los archivos del cuerpo del mensaje)
Public Sub SavenotdeleteAttachments()
Dim objOL As Outlook.Application
Dim objMsg As Outlook.mailItem 'Object
Dim objAttachments As Outlook.Attachments
Dim objSelection As Outlook.Selection
Dim i As Long
Dim lngCount As Long
Dim strFile As String
Dim strFolderpath As String
Dim strDeletedFiles As String

' Get the path to your My Documents folder
strFolderpath = "C:\adjuntos\"
On Error Resume Next

' Instantiate an Outlook Application object.
Set objOL = CreateObject("Outlook.Application")

' Get the collection of selected objects.
Set objSelection = objOL.ActiveExplorer.Selection

' The attachment folder needs to exist
' You can change this to another folder name of your choice

' Set the Attachment folder.
strFolderpath = strFolderpath

' Check each selected item for attachments.
For Each objMsg In objSelection

Set objAttachments = objMsg.Attachments
lngCount = objAttachments.Count

If lngCount > 0 Then

' Use a count down loop for removing items
' from a collection. Otherwise, the loop counter gets
' confused and only every other item is removed.

For i = lngCount To 1 Step -1

' Get the file name.
strFile = objAttachments.item(i).FileName

' Combine with the path to the Temp folder.
strFile = strFolderpath & strFile

' Save the attachment as a file.
objAttachments.item(i).SaveAsFile strFile

Next i
End If

Next

ExitSub:

Set objAttachments = Nothing
Set objMsg = Nothing
Set objSelection = Nothing
Set objOL = Nothing
End Sub

Salvamos

media_1350844508550.png
Clic en el disco o Control+S para salvar el proyecto.

Creación de carpeta "adjuntos"

media_1350844736761.png
Ese código presupone que existe una carpeta llamada "adjuntos" en la unidad C: . Como lo más probable es que no la tengamos debemos crearla puesto que aquí se salvarán los archivos adjuntados.

Seleccionar mensajes con adjuntos

media_1350844809709.png
Con la macro creada bastará con seleccionar los mensajes con adjuntos que deseemos guardar sin necesidad de abrirlos individualmente.

ALT+F8, Caja de diálogo de macros

media_1350844916438.png
Sin que se pierda la selección pulsamos ALT+F8 para activar la caja de macros. Seleccionamos nuestra macro, en este caso la última, y hacemos clic en ejecutar.

Archivos salvados en la carpeta adjuntos

media_1350845109482.png
Ya está, los archivos aparecerán salvados en esa carpeta. Esta macro resulta de gran utilidad cuando pretendamos salvar decenas de adjuntos de muchos mensajes.

Botón en la barra de menús

media_1350845270789.png
Podemos añadir el botón de la macro en la barra de menús para mayor comodidad.

51 comentarios:

  1. excelente me funciono de maravilla gracias eres un master!

    ResponderEliminar
  2. Una duda, se podria hacer para que se ejecutara la macro sola cada vez que entra un correo en la bandeja de entrada???

    Gracias por todo!

    ResponderEliminar
  3. Hola esta super bien me funciono perfecto, solo me queda la duda de si se pueden guardar los attachments con el nombre del ''Subject'' del mail???

    Mil gracias.

    ResponderEliminar
    Respuestas
    1. Guillermo Cerutti27 de mayo de 2014, 13:53

      es posible reemplazando

      strFile = objAttachments.Item(i).FileName

      por :
      strFile = objMsg.Subject

      (nota... si hay más de un adjunto por correo deberías usar algún contador y agregarlo al nombre)

      Eliminar
    2. Hola lo probé y funciona pero no me rescata la extencion en mi caso son .pdf

      Eliminar
    3. Este comentario ha sido eliminado por el autor.

      Eliminar
    4. Este comentario ha sido eliminado por el autor.

      Eliminar
    5. If InStr(objAttachments.Item(i).DisplayName, ".jpg") Then
      ' Save the attachment as a file.
      objAttachments.Item(i).SaveAsFile strFile
      'Set objAttachments = Nothing
      End If

      Eliminar
    6. Este comentario ha sido eliminado por el autor.

      Eliminar
    7. Hola buenos días. Help me jajaj. Lo que pasa es que necesito guardar los adjuntos con el.nombre del subject pero ya hice lo que comentaron arriba y sólo me guarda un archivo ya que son facturas. Pdf y xml me guarda uno pero sin la extensión no se como hacerle. Ayuda porfa.

      Eliminar
  4. Muy buen aporte. Gracias
    Hernán
    Ecuador

    ResponderEliminar
  5. Excelente, muchas gracias

    ResponderEliminar
  6. Lo voy a probar,
    de cualquier forma se ve bueno. Muchas gracias por compartir

    ResponderEliminar
  7. Gracias por la aportacion!!! probado y funcional.

    ResponderEliminar
  8. se puede hacer lo mismo sin usar macro mediante una regla o orden de outlook ?

    saludos

    ResponderEliminar
  9. Perfecto. Muchas gracias.
    Víctor

    ResponderEliminar
  10. muchas gracias por esta aportación me ayudo bastante en mis adjuntos.

    saludos

    ResponderEliminar
  11. Hola una consulta. es posible realizar la macro para descargar el archivo adjunto del remitente deseado,
    ya que a mi cuenta ingresan muchos mails con adjunto.sinembargo no necesito descarlos todos. ya que solo necesito de los mas importantes.
    si puedes ayudarme seria excelente. y buen aporte compañero.

    saludos,

    DTC

    ResponderEliminar
  12. hola buenas tarde tengo una dudota le programa no me gurda nada, ni siquiera me marca error que puedo hacer, me podrian orientar, por favor

    ResponderEliminar
    Respuestas
    1. fíjate que seguramente tipiaste mal el código...ja

      Eliminar
  13. MUY BUENO!!!

    GRACIAS POR COMPARTIRLO!!! :)

    ResponderEliminar
  14. Excelente, me salvaste !!! GRACIAS!!!

    ResponderEliminar
  15. wow, me has salvado horas de trabajo. Gracias, buen aporte.

    ResponderEliminar
  16. alguna forma de que me descargue todos los archivos aunque sean repetidos???

    ResponderEliminar
  17. LA otra opcion en caso de que no se pueda guardar los repetidos, que al guardarlos los vaya enumerando mejor, es decir que cuando ejecute la macro al guardarlos los ponga como 1,2,3,4,5,6,.......etc, y asi me descargue todos y los que esten duplicados los mantenga

    ResponderEliminar
  18. ¡Muchas gracias! Me ha sido de gran ayuda.

    ResponderEliminar
  19. Hola, se puede hacer que en el nombre del attachments sea la fecha de recepción del mail, es decir, el campo "Recibido".

    ResponderEliminar
  20. Excelente! me funciono con outlook 2010

    ResponderEliminar
  21. Magnifica Macro,muy util, un duda que tengo, alguien sabe decirme como puedo hacer para que el archivo adjunto me lo guarde en una carperta que estará creada, pero que tiene que coincidir con el texto del campo asunto del correo recibido.
    Estoy poniendo strFolderpath = "C:\adjuntos\" & objMsg.Suject & "\" , pero me da el siguiente mensaje. "Variable de Objeto o Bloque With no establecido". No se como solucionarlo, Saludos y gracias.

    ResponderEliminar
  22. Este comentario ha sido eliminado por el autor.

    ResponderEliminar
  23. Menudo ahorro de tiempo!! Gracias

    Alguna idea para que al adjunto que se guarda tome siempre una cadena fija del nombre del subjet?
    Sería siempre las mismas posiciones del subjet. Según el ejemplo seria que los nombrara con los números
    Por ejemplo:

    Correo 1: Adjunto 12345
    Correo 2: Adjunto 16789

    A ver si alguien lo sabe.

    ResponderEliminar
  24. muy buena aplicacion, gracias

    ResponderEliminar
  25. lo probe pero me dice que no hay correos en la bandeja de entrada, cuando en realidad hay 250 correos y casi todos ellos con adjuntos, ¿Qué puede estar pasando?? además de que ya lo había probado anteriormente y si funcionaba pero ahora que lo quiero intentar nuevamente no quiere, ¿por que será???

    ResponderEliminar
  26. como puedo agregar al nombre la fecha?

    ResponderEliminar
  27. Me salvo la vida!!!!! Muchas gracias por el aporte....

    ResponderEliminar
  28. Buen dia Pedro:

    He hecho una macro en Outlook 2007 que me permite exportar los mensajes de mi bandeja de entrada a un archivo de Excel, la cual funciona perfectamente, pero tengo un inconveniente. Necesito validar si un mensaje de mi bandeja de entrada ha sido respondido, y si ha sido así, en que fecha y hora se produjo esa respuesta. Podrias por favor ayudarme con un ejemplo de como podria validar esa parte??

    Te agradezco muchisimo por tu valiosa ayuda. Saludos

    ResponderEliminar
  29. ¿Porque no funciona en outlook 2016, me pueden indicar que debo cambiar el el codigo

    ResponderEliminar
  30. Excelente me funciono perfecto , ahora como puedo hacer para que una vez que tenga los archivos en el folder adjunto forme un nuevo correo y adjunto todos los archivos que descargo?

    ResponderEliminar
  31. Solo me guarda uno de los adjuntos. En mi caso los incrustados en el cuerpo del correo con formato html. Me gustaría guardar únicamente los adjuntos y no los incrustados

    ResponderEliminar
  32. Muy buena macro, es posible que esta misma macro pero que si me elimine los archivos del cuerpo del mensaje y me deje una liga para accesar el archivo y no llenar el buzon? Me pueden ayudar

    ResponderEliminar
  33. Excelente, me funcionó perfecto!!! Se me presenta el caso que tengo mails con adjunto otro mail, y ese a su vez contiene un PDF adjunto y no logro llegar al PDF para guardarlo, me podrán ayudar? ...

    ResponderEliminar
  34. hola, cree una macro similar a esta que me guarda los archivos adjuntos en la carpeta indicada.
    El problema que se me plantea es que necesito que la macro modifique el nombre del archivo guardado, poniendo como nombre el cuerpo del correo (los correos donde quiero aplicar esta macro tienen cuerpos cortos un ejemplo:"Errores En: TARMK1", y los archivos adjuntos son .zip
    alguien me podría ayudar?

    el código es el siguiente-----------------------------------------------

    Sub GuardarAdjuntos()
    Dim Adjunto As Attachment
    Dim NombreArchivo As String
    Dim i As Integer
    Dim seleccion As Outlook.MailItem
    Dim NombreNew As String

    For Each seleccion In Application.ActiveExplorer.Selection

    'LOG Guarda el texto del email
    'Opening the text file for Append with FileNumber as 1.
    Open "RUTA A LA CARPETA\Cuerpo.txt" For Append As #1
    Write #1, "========================================================================================================"
    Write #1, seleccion.Body
    Write #1, "========================================================================================================"
    Close #1
    NombreNew = "RUTA A LA CARPETA\" & seleccion.Body & ".zip"

    'Guarda el archivo adjunto del email
    For Each Adjunto In seleccion.Attachments
    NombreArchivo = "RUTA A LA CARPETA\" & Adjunto.FileName 'para conservar nombre original
    Adjunto.SaveAsFile NombreArchivo
    Name NombreArchivo As NombreNew
    i = i + 1
    Next Adjunto
    Next seleccion
    End Sub

    ResponderEliminar
  35. Cómo guardar el adjunto en una carpeta, dependiendo de lo que tenga el asunto, es decir, que sí en el asunto dice "Alta" que me lo guarde en la carpeta Altas, sí en el asunto dice baja que me lo guarde en la carpeta bajas y así.. dependiendo de lo venga en el asunto.

    ResponderEliminar
  36. Hola, Excelente aporte! es posible modificar el codigo para que elimine el mail una vez descargado el attach y "pise" el file existente en la dir de destino?

    ResponderEliminar
  37. Muchas gracias. Tu aportación me ahorrará mucho tiempo de vida.

    ResponderEliminar
  38. Muchas gracias. Las Macros que probé anteriormente definían un objeto diferente y sufria con el mismatch 13

    ResponderEliminar