Wednesday, April 17, 2013

Macro to remove attachments

People in my organization often don't pay attention to the size of the email attachments. My habit is to save the emails to the PST files. Hence the problem: my PCT files are huge. The solution: remove attachments. Simple Marco does the trick:


Sub RemoveAttachments()
    Dim oMailItem As MailItem
    Dim objAttachments As Outlook.Attachments
    Dim i As Integer
    Set oMailItem = Application.ActiveExplorer.Selection.Item(1)
    Set objAttachments = oMailItem.Attachments
    If objAttachments.Count > 0 Then
        For i = objAttachments.Count To 1 Step -1
            objAttachments.Item(i).Delete
        Next i
        oMailItem.Close (olSave)
    End If
    Set oMailItem = Nothing
End Sub