¿Cómo eliminar automáticamente los archivos adjuntos después del envío de correos electrónicos desde los elementos enviados?

Al enviar un correo electrónico con algunos archivos adjuntos, los archivos adjuntos se almacenarán con los correos electrónicos en la carpeta de elementos enviados de forma predeterminada. Para reducir el tamaño de su archivo PST, es posible que desee eliminar los archivos adjuntos de los elementos enviados automáticamente después del envío de correos electrónicos. En este artículo, hablaré sobre esta tarea en Outlook.

Elimine automáticamente los archivos adjuntos después del envío de correos electrónicos desde los elementos enviados

Elimine automáticamente los archivos adjuntos después del envío de correos electrónicos desde los elementos enviados

El siguiente código VBA puede ayudarlo a eliminar automáticamente los archivos adjuntos después de que los correos electrónicos se envíen desde Outlook, haga lo siguiente:

1. Mantenga pulsado el ALT + F11 teclas para abrir el Microsoft Visual Basic para aplicaciones ventana.

2. En Microsoft Visual Basic para aplicaciones ventana, haga doble clic Esta sesión de Outlook del desplegable Proyecto1 (VbaProject.OTM) panel para abrir el modo y luego copie y pegue el siguiente código en el módulo en blanco.

Código VBA: elimine automáticamente los archivos adjuntos después de los correos electrónicos enviados desde los elementos enviados:

Public WithEvents SentMailItems As Outlook.Items
    Private Sub Application_Startup()
    Set SentMailItems = Outlook.Application.Session.GetDefaultFolder(olFolderSentMail).Items
    End Sub
    Sub SentMailItems_ItemAdd(ByVal Item As Object)
    Dim xSentMail As Outlook.MailItem
    Dim xAttachments As Outlook.Attachments
    Dim xAttachment As Outlook.Attachment
    Dim xAttachmentInfo As String
    On Error Resume Next
    If Item.Class = olMail Then
       Set xSentMail = Item
    End If
    Set xAttachments = xSentMail.Attachments
    For i = xAttachments.Count To 1 Step -1
        Set xAttachment = xAttachments.Item(i)
        xAttachmentInfo = "<HTML><BODY>" & xAttachment.DisplayName & _
                          "</BODY></HTML>" & vbCrLf & xAttachmentInfo
        xAttachment.Delete
    Next
    xSentMail.HTMLBody = "<HTML><BODY><font color=#FF0000>Attachment Removed: </font><br/></BODY></HTML>" & _
                         xAttachmentInfo & "<HTML><BODY><br/></BODY></HTML>" & xSentMail.HTMLBody
    xSentMail.Save
End Sub

3. Después de insertar el código anterior, reinicie Outlook para que el código surta efecto.

4. De ahora en adelante, cuando envíe correos electrónicos con archivos adjuntos, los archivos adjuntos se eliminarán automáticamente de los elementos enviados como se muestra a continuación: