Gandalf's notebook: Remove Flags from Inbox Emails

From codeforexcelandoutlook.com

In Don’t let senders flag message with Reminder for me there is a method for removing follow up flags from emails. Here I will present a VBA method (both manual and event-driven) for doing the same.

Personally, I dislike those follow up flags. The mere fact that an email was sent implies that some kind of response or follow up is being requested. A flag is just piling on. I will decide if and when to follow up on an email.

Manual / On Demand Method

This code may be run as needed to remove flags on existing emails in the default Inbox.

Sub RemoveFlags()
 Dim itms As Outlook.Items
 Dim msg As Outlook.mailItem
 Dim i As Long

 ' get default Inbox folder items
 Set itms = GetItems(GetNS(GetOutlookApp), olFolderInbox)

 For i = 1 To itms.count
   If TypeName(itms.Item(i)) = "MailItem" Then

     Set msg = itms.Item(i)
     ' remove flags
     With msg
       .FlagStatus = olNoFlag
       .FlagIcon = olNoFlagIcon
       .Save
     End With

   End If
 Next i
End Sub

This code should be placed in a standard module in Outlook's VBA editor (see Where do I put my Outlook VBA code for placement assistance).

Event Handler

Suppose you wanted to remove flags on all incoming emails automatically. Kudos to you for being brave. I started with the event handler found at Stock Event Code and produced this code:

Private WithEvents Items As Outlook.Items

Private Sub Application_Startup()
 Set Items = GetItems(GetNS(GetOutlookApp), olFolderInbox)
End Sub

Private Sub Items_ItemAdd(ByVal item As Object)
 On Error GoTo ErrorHandler

 Dim msg As Outlook.mailItem

 If TypeName(item) = "MailItem" Then
   Set msg = item
   With msg
     .FlagStatus = olNoFlag
     .FlagIcon = olNoFlagIcon
     .Save
   End With
 End If
ProgramExit:
 Exit Sub
ErrorHandler:
 MsgBox Err.Number & " - " & Err.Description
 Resume ProgramExit
End Sub

This code should be placed in the ThisOutlookSession module in Outlook's VBA editor (see Where do I put my Outlook VBA code for placement assistance). Restart Outlook and then ask someone to send you an email with a follow up flag.

Ancillary Functions

Note that both of the above sections of code need these procedures. Paste them into a standard module.

Function GetItems(olNS As Outlook.NameSpace, _
                    folder As OlDefaultFolders) As Outlook.Items
 Set GetItems = olNS.GetDefaultFolder(folder).Items
End Function
Function GetNS(ByRef app As Outlook.Application) As Outlook.NameSpace
 Set GetNS = app.GetNamespace("MAPI")
End Function
Function GetOutlookApp() As Outlook.Application
 Set GetOutlookApp = Outlook.Application
End Function