¿Cómo guardar todos los archivos adjuntos de varios correos en una sola carpeta en Outlook?

Es fácil guardar todos los archivos adjuntos de un correo electrónico gracias a la función integrada «Guardar todos los archivos adjuntos» de Outlook. Sin embargo, si desea guardar los archivos adjuntos de varios mensajes a la vez, no existe una opción directa para hacerlo. Tendría que aplicar repetidamente la función «Guardar todos los archivos adjuntos» en cada correo hasta que se hayan descargado todos los archivos, lo que resulta muy tedioso y consume mucho tiempo. En este artículo le presentamos dos métodos eficaces para guardar masivamente todos los archivos adjuntos de varios correos en una carpeta específica de Outlook.

Guardar todos los archivos adjuntos de varios correos en una carpeta con código VBA
Varios clics para guardar todos los archivos adjuntos de varios correos en una carpeta con una herramienta sorprendente

Guardar todos los archivos adjuntos de varios correos en una carpeta con código VBA

Esta sección le guía paso a paso mediante un código VBA que le permitirá guardar rápidamente todos los archivos adjuntos de varios correos electrónicos en una carpeta específica, de forma simultánea. Siga estos pasos.

1. En primer lugar, cree una carpeta en su equipo para guardar los archivos adjuntos.

Acceda a la carpeta «Documentos» y cree una subcarpeta llamada «Attachments». Consulte la captura de pantalla:

2. Seleccione los correos cuyos archivos adjuntos desea guardar y pulse las teclas «Alt» + "F11" para abrir la ventana de Microsoft Visual Basic para Aplicaciones.

3. Haga clic en «Insertar» > «Módulo» para abrir la ventana del módulo y copie uno de los siguientes códigos VBA en ella.

Código VBA 1: Guardar masivamente archivos adjuntos de varios correos (guardar directamente archivos adjuntos con nombres idénticos)

Consejo: Este código guardará los archivos adjuntos con nombres idénticos añadiendo los dígitos 1, 2, 3… tras el nombre del archivo.

Dim GCount As Integer
Dim GFilepath As String
Public Sub SaveAttachments()
'Update 20200821
Dim xMailItem As Outlook.MailItem
Dim xAttachments As Outlook.Attachments
Dim xSelection As Outlook.Selection
Dim i As Long
Dim xAttCount As Long
Dim xFilePath As String, xFolderPath As String, xSaveFiles As String
On Error Resume Next
xFolderPath = CreateObject("WScript.Shell").SpecialFolders(16)
Set xSelection = Outlook.Application.ActiveExplorer.Selection
xFolderPath = xFolderPath & "\Attachments\"
If VBA.Dir(xFolderPath, vbDirectory) = vbNullString Then
    VBA.MkDir xFolderPath
End If
GFilepath = ""
For Each xMailItem In xSelection
    Set xAttachments = xMailItem.Attachments
    xAttCount = xAttachments.Count
    xSaveFiles = ""
    If xAttCount > 0 Then
        For i = xAttCount To 1 Step -1
            GCount = 0
            xFilePath = xFolderPath & xAttachments.Item(i).FileName
            GFilepath = xFilePath
            xFilePath = FileRename(xFilePath)
            If IsEmbeddedAttachment(xAttachments.Item(i)) = False Then
                xAttachments.Item(i).SaveAsFile xFilePath
                If xMailItem.BodyFormat <> olFormatHTML Then
                    xSaveFiles = xSaveFiles & vbCrLf & "<Error! Hyperlink reference not valid.>"
                Else
                    xSaveFiles = xSaveFiles & "<br>" & "<a href='file://" & xFilePath & "'>" & xFilePath & "</a>"
                End If
            End If
        Next i
    End If
Next
Set xAttachments = Nothing
Set xMailItem = Nothing
Set xSelection = Nothing
End Sub

Function FileRename(FilePath As String) As String
Dim xPath As String
Dim xFso As FileSystemObject
On Error Resume Next
Set xFso = CreateObject("Scripting.FileSystemObject")
xPath = FilePath
FileRename = xPath
If xFso.FileExists(xPath) Then
    GCount = GCount + 1
    xPath = xFso.GetParentFolderName(GFilepath) & "\" & xFso.GetBaseName(GFilepath) & " " & GCount & "." + xFso.GetExtensionName(GFilepath)
    FileRename = FileRename(xPath)
End If
xFso = Nothing
End Function

Function IsEmbeddedAttachment(Attach As Attachment)
Dim xItem As MailItem
Dim xCid As String
Dim xID As String
Dim xHtml As String
On Error Resume Next
IsEmbeddedAttachment = False
Set xItem = Attach.Parent
If xItem.BodyFormat <> olFormatHTML Then Exit Function
xCid = ""
xCid = Attach.PropertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x3712001F")
If xCid <> "" Then
    xHtml = xItem.HTMLBody
    xID = "cid:" & xCid
    If InStr(xHtml, xID) > 0 Then
        IsEmbeddedAttachment = True
    End If
End If
End Function

Código VBA 2: Guardar masivamente archivos adjuntos de varios correos (comprobar duplicados)

Public Sub SaveAttachments()
'Update 20200821
Dim xMailItem As Outlook.MailItem
Dim xAttachments As Outlook.Attachments
Dim xSelection As Outlook.Selection
Dim i As Long
Dim xAttCount As Long
Dim xFilePath As String, xFolderPath As String, xSaveFiles As String
Dim xYesNo As Integer
Dim xFlag As Boolean
On Error Resume Next
xFolderPath = CreateObject("WScript.Shell").SpecialFolders(16)
Set xSelection = Outlook.Application.ActiveExplorer.Selection
xFolderPath = xFolderPath & "\Attachments\"
If VBA.Dir(xFolderPath, vbDirectory) = vbNullString Then
    VBA.MkDir xFolderPath
End If
For Each xMailItem In xSelection
    Set xAttachments = xMailItem.Attachments
    xAttCount = xAttachments.Count
    xSaveFiles = ""
    If xAttCount > 0 Then
        For i = xAttCount To 1 Step -1
            xFilePath = xFolderPath & xAttachments.Item(i).FileName
            xFlag = True
            If VBA.Dir(xFilePath, 16) <> Empty Then
                xYesNo = MsgBox("The file is exists, do you want to replace it", vbYesNo + vbInformation, "Kutools for Outlook")
                If xYesNo = vbNo Then xFlag = False
            End If
            If xFlag = True Then
                xAttachments.Item(i).SaveAsFile xFilePath
                If xMailItem.BodyFormat <> olFormatHTML Then
                    xSaveFiles = xSaveFiles & vbCrLf & "<Error! Hyperlink reference not valid.>"
                Else
                    xSaveFiles = xSaveFiles & "<br>" & "<a href='file://" & xFilePath & "'>" & xFilePath & "</a>"
                End If
            End If
        Next i
    End If
Next
Set xAttachments = Nothing
Set xMailItem = Nothing
Set xSelection = Nothing
End Sub

Notas:

1) Si desea guardar todos los archivos adjuntos con el mismo nombre en una carpeta, aplique el «Código VBA 1» anterior. Antes de ejecutar este código, haga clic en «Herramientas» > «Referencias» y active la casilla «Microsoft Scripting Runtime» en el cuadro de diálogo «Referencias: Proyecto».

2) Si desea comprobar si hay archivos adjuntos Nombre del Adjunto duplicados, aplique el «Código VBA 2». Tras ejecutar el código, aparecerá un cuadro de diálogo que le preguntará si desea reemplazar el Adjuntos duplicados; elija «Sí» o «No» según sus necesidades.

5. Pulse la tecla "F5" para ejecutar el código.

Así, todos los archivos adjuntos de los correos seleccionados se guardarán en la carpeta creada en el paso 1.

Nota: Es posible que aparezca un cuadro de diálogo de «Microsoft Outlook»; en ese caso, haga clic en el botón «Permitir» para continuar.

Guardar todos los archivos adjuntos de varios correos en una carpeta con una herramienta sorprendente

Si es nuevo en VBA, le recomendamos encarecidamente la utilidad «Guardar todos los archivos adjuntos» de Kutools para Outlook. Con esta herramienta podrá guardar rápidamente todos los archivos adjuntos de varios correos con solo unos pocos clics en Outlook.

1. Seleccione los correos electrónicos que contengan los archivos adjuntos que desee guardar.

Consejo: Puede seleccionar varios correos no adyacentes manteniendo pulsada la tecla «Ctrl» y haciendo clic en ellos uno a uno;
o bien seleccionar varios correos adyacentes manteniendo pulsada la tecla «Mayús» y haciendo clic en el primero y en el último correo.

2. Haga clic en «KUTOOLS PLUS» > «Herramientas de archivos adjuntos» > «Guardar todo». Vea la captura de pantalla:

3. En el cuadro de diálogo «Configuración de guardado», haga clic en el botón para seleccionar una carpeta: elija la ubicación donde guardar los archivos adjuntos y, a continuación, haga clic en «Aceptar».

4. Haga doble clic en «Aceptar» en los cuadros de diálogo emergentes siguientes para guardar simultáneamente todos los archivos adjuntos de los correos seleccionados en la carpeta especificada.

Notas:

• 1. Si desea guardar los archivos adjuntos en carpetas distintas según el correo electrónico, active la casilla «Crear subcarpetas con el siguiente estilo» y elija un estilo de carpeta en el menú desplegable.
• 2. Además de guardar todos los archivos adjuntos, puede hacerlo según condiciones específicas. Por ejemplo, si solo desea conservar los archivos PDF cuyo nombre incluya la palabra «Invoice», haga clic en el botón «Opciones avanzadas» para expandir las condiciones y configúrelo como se muestra a continuación.
  
• 3. Si desea guardar automáticamente los archivos adjuntos cuando lleguen los correos electrónicos, la función Guardar automáticamente los adjuntos puede ayudarle.
• 4. Para desvincular directamente los archivos adjuntos de los correos seleccionados, la función Desvincular todos los archivos adjuntosde «Kutools para Outlook» le resultará de gran utilidad.

Artículos relacionados

---

Las mejores herramientas de productividad para Office

¡Descubra el nuevo Kutools para Outlook con 100+ funciones increíbles!¡Haga clic para descargar ahora!

🤖KUTOOLS AI:Utiliza tecnología avanzada de IA para gestionar correos electrónicos sin esfuerzo, incluyendo responder, resumir, optimizar, ampliar, traducir y redactar correos.

📧Automatización de correo electrónico: Respuesta automática (disponible para POP e IMAP) / Programar el envío de correos electrónicos / CC/BCC automático según reglas al enviar correos / Reenvío automático (regla avanzada) / Añadir saludo automáticamente / Dividir automáticamente los correos con múltiples destinatarios en mensajes individuales...

📨Gestión de correo electrónico: Recupera tus correos electrónicos / Bloquea correos fraudulentos por asunto y otros criterios / Elimina correos electrónicos duplicados / Búsqueda avanzada / Organiza tus carpetas…

📁Archivos adjuntos Pro: Guardar en lote / Desvincular en lote / Comprimir en lote / Guardar automáticamente / Desconectar automáticamente / Auto comprimir...

🌟Magia de la interfaz: 😊Más emojis bonitos y modernos / Le avisa cuando llegan correos importantes / Minimiza Outlook en lugar de cerrarlo…

👍Maravillas con un solo clic: Responder a Todos con Adjuntos / Correos electrónicos antiphishing / 🕘 Mostrar zona horaria: hora actual del remitente...

👩🏼‍🤝‍👩🏻Contactos y calendario: Crear contactos en lote a partir de correos seleccionados / Dividir un grupo de contactos en grupos individuales / Eliminar recordatorio de cumpleaños...

Utilice Kutools en su idioma preferido: compatible con inglés, español, alemán, francés, chino y más de 40 idiomas adicionales.

Desbloquee Kutools para Outlook al instante con un solo clic. ¡No espere más: descárguelo ahora y potencie su eficiencia!

Lista de funciones de Kutools para Outlook      Descargar ahora      Ir a comprar

🚀 Descarga con un solo clic — Obtenga todos los complementos de Office

Muy recomendado: Kutools for Office (5 en 1)

Un solo clic para descargar cinco instaladoresa la vez —Kutools para Excel, Outlook, Word, PowerPointy Office Tab Pro.¡Haga clic para descargar ahora!

• ✅Comodidad con un solo clic: Descargue los cinco paquetes de instalación de una sola vez.
• 🚀Listo para cualquier tarea de Office: Instale los complementos que necesite, justo cuando los necesite.
• 🧰Incluido: Kutools para Excel / Kutools para Outlook / Kutools para Word / Office Tab Pro / Kutools for PowerPoint

Acerca del Conjunto⬇ Descargar el Conjunto💳 Comprar el Conjunto