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
Abrimos el editor pulsando ALT+F11.
Ventana de proyectos
A la izquierda tenemos la ventana de proyectos. Hacemos doble clic en ThisOutlookSession.
Pegado de código
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
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
Clic en el disco o Control+S para salvar el proyecto.
Creación de carpeta "adjuntos"
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
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
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
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
Podemos añadir el botón de la macro en la barra de menús para mayor comodidad.
U MADE MY DAY!111
ResponderEliminarThnks a lot! =)
excelente me funciono de maravilla gracias eres un master!
ResponderEliminarUna duda, se podria hacer para que se ejecutara la macro sola cada vez que entra un correo en la bandeja de entrada???
ResponderEliminarGracias por todo!
No anda
ResponderEliminarHola 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???
ResponderEliminarMil gracias.
es posible reemplazando
EliminarstrFile = 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)
Hola lo probé y funciona pero no me rescata la extencion en mi caso son .pdf
EliminarEste comentario ha sido eliminado por el autor.
EliminarEste comentario ha sido eliminado por el autor.
EliminarIf InStr(objAttachments.Item(i).DisplayName, ".jpg") Then
Eliminar' Save the attachment as a file.
objAttachments.Item(i).SaveAsFile strFile
'Set objAttachments = Nothing
End If
Este comentario ha sido eliminado por el autor.
EliminarHola 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.
EliminarMuy buen aporte. Gracias
ResponderEliminarHernán
Ecuador
Excelente, muchas gracias
ResponderEliminarLo voy a probar,
ResponderEliminarde cualquier forma se ve bueno. Muchas gracias por compartir
Gracias por la aportacion!!! probado y funcional.
ResponderEliminarEXCELENTE APLICACIO..
ResponderEliminarse puede hacer lo mismo sin usar macro mediante una regla o orden de outlook ?
ResponderEliminarsaludos
no
EliminarPerfecto. Muchas gracias.
ResponderEliminarVíctor
muchas gracias por esta aportación me ayudo bastante en mis adjuntos.
ResponderEliminarsaludos
Hola una consulta. es posible realizar la macro para descargar el archivo adjunto del remitente deseado,
ResponderEliminarya 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
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
ResponderEliminarfíjate que seguramente tipiaste mal el código...ja
EliminarGRACIAS!!!!!!!!!!!!!!!!
ResponderEliminarMUY BUENO!!!
ResponderEliminarGRACIAS POR COMPARTIRLO!!! :)
Excelente, me salvaste !!! GRACIAS!!!
ResponderEliminarwow, me has salvado horas de trabajo. Gracias, buen aporte.
ResponderEliminaralguna forma de que me descargue todos los archivos aunque sean repetidos???
ResponderEliminarLA 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¡Muchas gracias! Me ha sido de gran ayuda.
ResponderEliminarHola, se puede hacer que en el nombre del attachments sea la fecha de recepción del mail, es decir, el campo "Recibido".
ResponderEliminarExcelente! me funciono con outlook 2010
ResponderEliminarMagnifica 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.
ResponderEliminarEstoy 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.
Este comentario ha sido eliminado por el autor.
ResponderEliminarMenudo ahorro de tiempo!! Gracias
ResponderEliminarAlguna 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.
muy buena aplicacion, gracias
ResponderEliminarlo 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á???
ResponderEliminarcomo puedo agregar al nombre la fecha?
ResponderEliminarMe salvo la vida!!!!! Muchas gracias por el aporte....
ResponderEliminarBuen dia Pedro:
ResponderEliminarHe 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
¿Porque no funciona en outlook 2016, me pueden indicar que debo cambiar el el codigo
ResponderEliminarExcelente 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?
ResponderEliminarSolo 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
ResponderEliminarMuy 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
ResponderEliminarExcelente, 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? ...
ResponderEliminarhola, cree una macro similar a esta que me guarda los archivos adjuntos en la carpeta indicada.
ResponderEliminarEl 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
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.
ResponderEliminarHola, 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?
ResponderEliminarMuchas gracias. Tu aportación me ahorrará mucho tiempo de vida.
ResponderEliminarMuchas gracias. Las Macros que probé anteriormente definían un objeto diferente y sufria con el mismatch 13
ResponderEliminar