Tengo la costumbre de guardar todos o casi todos los correos. Esto tiene el inconveniente de que el archivo pst va creciendo mucho y manejar un archivo de 500 megas es ... digamos incómodo. Planteé la cuestón de cómo se podrían eliminar ciertos adjuntos sin eliminar el correo y nuestra compañera Marta (MVP de Office) me remitió a http://www.outlookcode.com/codedetail.aspx?id=70 Probé esa macro y funciona perfectamente. No tenéis más que copiar/pegar en un archivo .bas e importarlo directamente el OL 2003. Esta macro graba los adjuntos de los correos seleccionados a una carpeta del disco y luego elimina éste añadiendo una referencia en el correo. Sólo hice una ligera modificación para que si no se selecciona ninguna carpeta para guardar los adjuntos no haga nada. Otra cosa a tener en cuenta: si la extensión del adjunto está bloqueada por OL (por ejemplo .exe) se deberá desbloquear previamente.
Teniendo este código es relativamente sencillo modificar la macro a nuestro gusto. Por ejemplo, para que elimine los correos de cierto tamaño al cabo de cierto tiempo ... En fin, sólo hace falta un poco de imaginación y tirar de Google ;-)

Si lo deseáis podéis descargar el script ya hecho desde nuestra sección de descargas.

-------------------------  NO COPIAR ESTA LINEA ---------------------------

Attribute VB_Name = "Módulo1"<br />Sub SaveAttachment()<br />'Declaration<br />Dim myItems, myItem, myAttachments, myAttachment As Object<br />Dim myOrt As String<br />Dim myOlApp As New Outlook.Application<br />Dim myOlExp As Outlook.Explorer<br />Dim myOlSel As Outlook.Selection</p> <p>'Ask for destination folder<br />myOrt = InputBox("Destino de los adjuntos", "Guarda adjuntos", "C:\")</p> <p>On Error Resume Next<br />If myOrt <> "" Then
    'work on selected items
    Set myOlExp = myOlApp.ActiveExplorer
    Set myOlSel = myOlExp.Selection
   
    'for all items do...
    For Each myItem In myOlSel
        'point on attachments
        Set myAttachments = myItem.Attachments
        'if there are some...
        If myAttachments.Count > 0 Then
            'add remark to message text
            myItem.Body = myItem.Body & vbCrLf & "Adjuntos eliminados:" & vbCrLf
            'for all attachments do...
            For i = 1 To myAttachments.Count
                'save them to destination
                myAttachments(i).SaveAsFile myOrt & myAttachments(i).DisplayName
                'add name and destination to message text
                myItem.Body = myItem.Body & "Archivo: " & myOrt & myAttachments(i).DisplayName & vbCrLf
            Next i
            'for all attachments do...
            While myAttachments.Count > 0
                'remove it (use this method in Outlook XP)
                myAttachments.Remove 1
                'remove it (use this method in Outlook 2000)
                'myAttachments(1).Delete
            Wend
            'save item without attachments
            myItem.Save
        End If
    Next
End If

'free variables
Set myItems = Nothing
Set myItem = Nothing
Set myAttachments = Nothing
Set myAttachment = Nothing
Set myOlApp = Nothing
Set myOlExp = Nothing
Set myOlSel = Nothing
End Sub

-------------------------  NO COPIAR ESTA LINEA ---------------------------