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

Es fácil guardar todos los archivos adjuntos de un correo electrónico con la función integrada Guardar todos los archivos adjuntos en Outlook. Sin embargo, si desea guardar todos los archivos adjuntos de varios correos electrónicos a la vez, no hay ninguna función directa que pueda ayudar. Debe aplicar repetidamente la función Guardar todos los archivos adjuntos en cada correo electrónico hasta que se guarden todos los archivos adjuntos de esos correos electrónicos. Eso lleva mucho tiempo. En este artículo, presentamos dos métodos para que guarde de forma masiva todos los archivos adjuntos de varios correos electrónicos en una carpeta específica fácilmente en Outlook.

Guarde todos los archivos adjuntos de varios correos electrónicos en una carpeta con código VBA
Varios clics para guardar todos los archivos adjuntos de varios correos electrónicos en una carpeta con una herramienta increíble

Guarde todos los archivos adjuntos de varios correos electrónicos en una carpeta con código VBA

Esta sección muestra un código VBA en una guía paso a paso para ayudarlo a guardar rápidamente todos los archivos adjuntos de varios correos electrónicos en una carpeta específica a la vez. Haz lo siguiente.

1. En primer lugar, debe crear una carpeta para guardar los archivos adjuntos en su computadora.

Entra en el Documentos carpeta y cree una carpeta llamada "Archivos adjuntos". Ver captura de pantalla:

2. Seleccione los correos electrónicos que guardará los archivos adjuntos y luego presione otro + F11 teclas para abrir el Microsoft Visual Basic para aplicaciones ventana.

3. Hacer clic en recuadro > Módulo para abrir el Módulo ventana y luego copie uno de los siguientes códigos VBA en la ventana.

Código 1 de VBA: guarde en bloque los archivos adjuntos de varios correos electrónicos (guarde los archivos adjuntos del mismo nombre directamente)

Tips: Este código guardará exactamente los mismos nombres adjuntos agregando los dígitos 1, 2, 3 ... después de los nombres de los archivos.

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 2 de VBA: guarde en bloque los archivos adjuntos de varios correos electrónicos (verifique si hay 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:

5. presione el F5 clave para ejecutar el código.

Luego, todos los archivos adjuntos en los correos electrónicos seleccionados se guardan en la carpeta que creó en el paso 1. 

Notas: Puede haber un microsoft Outlook cuadro emergente, haga clic en el Permitir botón para seguir adelante.

Guarde todos los archivos adjuntos de varios correos electrónicos en una carpeta con una herramienta increíble

Si eres un novato en VBA, aquí recomendamos encarecidamente el Guardar todos los archivos adjuntos utilidad de Kutools para Outook para ti. Con esta utilidad, puede guardar rápidamente todos los archivos adjuntos de varios correos electrónicos a la vez con varios clics solo en Outlook.
Antes de aplicar la función, descargue e instale Kutools para Outlook en primer lugar.

1. Seleccione los correos electrónicos que contienen los archivos adjuntos que desea guardar.

Consejos: Puede seleccionar varios correos electrónicos no adyacentes manteniendo presionada la Ctrl clave y selecciónelos uno por uno;
O seleccione varios correos electrónicos adyacentes manteniendo presionada la Shift y seleccione el primer correo electrónico y el último.

2. Hacer clic en Kutools >Herramientas de adjunto > Guardar todo. Ver captura de pantalla:

3. En el Guardar configuración diálogo, haga clic en para seleccionar una carpeta para guardar los archivos adjuntos, y luego haga clic en el OK del botón.

3. Hacer clic en OK dos veces en el siguiente cuadro de diálogo emergente, luego todos los archivos adjuntos en los correos electrónicos seleccionados se guardan en la carpeta especificada a la vez.

Notas:

• 1. Si desea guardar archivos adjuntos en diferentes carpetas según los correos electrónicos, marque la casilla Cree subcarpetas con el siguiente estilo cuadro y elija un estilo de carpeta en el menú desplegable.
• 2. Además de guardar todos los archivos adjuntos, puede guardar archivos adjuntos según condiciones específicas. Por ejemplo, solo desea guardar los archivos adjuntos del archivo pdf cuyo nombre de archivo contiene la palabra "Factura", haga clic en el Opciones avanzadas para expandir las condiciones, y luego configure como se muestra la captura de pantalla a continuación.
  
• 3. Si desea guardar automáticamente los archivos adjuntos cuando llegue el correo electrónico, Guardar archivos adjuntos automáticamente función puede ayudar.
• 4. Para separar los archivos adjuntos directamente de los correos electrónicos seleccionados, Separar todos los archivos adjuntos característica de Kutools para Outlook puedo hacerte un favor

Artículos relacionados

---

Las mejores herramientas de productividad de oficina

Kutools para Outlook - Más de 100 potentes funciones para potenciar tu perspectiva

🤖 Asistente de correo AI: Correos electrónicos profesionales instantáneos con magia de IA: respuestas geniales con un clic, tono perfecto y dominio multilingüe. ¡Transforme el correo electrónico sin esfuerzo! ...

📧 Automatización de correo electrónico: Fuera de la oficina (disponible para POP e IMAP)  /  Programar envío de correos electrónicos  /  CC/CCO automático según reglas al enviar correo electrónico  /  Reenvío automático (reglas avanzadas)   /  Agregar saludo automáticamente   /  Divida automáticamente correos electrónicos de múltiples destinatarios en mensajes individuales ...

📨 Gestión de correo electrónico: Recuperar correos electrónicos fácilmente  /  Bloquear correos electrónicos fraudulentos por sujetos y otras personas  /  Eliminar correos electrónicos duplicados  /  Búsqueda Avanzada  /  Consolidar carpetas ...

📁 Archivos adjuntos profesionales: Guardar lote  /  Separación de lotes  /  Comprimir por lotes  /  Ahorro automático   /  Desconexión automática  /  Autocompresión ...

???? Interfaz mágica: 😊Más emojis bonitos y geniales   /  Aumente su productividad en Outlook con vistas con pestañas  /  Minimizar Outlook en lugar de cerrar ...

👍 Maravillas con un clic: Responder a todos los archivos adjuntos entrantes  /   Correos electrónicos antiphishing  /  🕘Mostrar zona horaria del remitente ...

👩🏼‍🤝‍👩🏻 Contactos y calendario: Agregar por lotes contactos de correos electrónicos seleccionados  /  Dividir un grupo de contactos en grupos individuales  /  Eliminar recordatorios de cumpleaños ...

Mas de Características 100 ¡Espere su exploración! Haga clic aquí para descubrir más.

Leer Mas       Descargar gratis      Comprar