Outlook - attachment warnings and folder cleanups

'Press Alt-F11 and enter this first one in "ThisOutlookSession" to warn you whenever you write the word "attach" and forget to send an attachment
'If it doesn't work, reduce macro security to "medium" and restart Outlook

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim lngres As Long
If InStr(1, UCase(Item.Body), "ATTACH") <> 0 Then
If Item.Attachments.Count = 0 Then
lngres = MsgBox("No attachment - send anyway?", _
vbYesNo + vbDefaultButton2 + vbQuestion, "No attachment")
If lngres = vbNo Then Cancel = True
End If
End If
End Sub

'This second one is trickier but more useful. It converts all mails in a folder to plain text and removes attachments. You have to add a rule to use it
'Enter this one in "ThisOutlookSession" too but add a rule to run when mails arrive and set it to run this script
'DO NOT enable the rule. Run the rule on a need-to basis on your saved emails. You can even opt for subfolders to processed.
'This should drastically reduce your PST file size. You may need to force a "compact now" on your PST file to see the size difference.
'Also, for mails with embedded images you may need to run this more than once since it'll first convert the images to included files (inaccessible from the UI)

Sub ConvertHTMLToPlain(MyMail As MailItem)
Dim strID As String
Dim olNS As Outlook.NameSpace
Dim olMail As Outlook.MailItem

strID = MyMail.EntryID
Set olNS = Application.GetNamespace("MAPI")
Set olMail = olNS.GetItemFromID(strID)

If olMail.BodyFormat <> olFormatPlain Then
olMail.BodyFormat = olFormatPlain
olMail.Save
End If

If olMail.Attachments.Count > 0 Then
For Each objAtt In olMail.Attachments
objAtt.Delete
Next
olMail.Save
End If

Set olMail = Nothing
Set olNS = Nothing
End Sub

Comments

Archive

Show more