Attribute VB_Name = "Module1"
Option Explicit

Public Sub remove_keywords()
'
'Goes through the inbox folder and removes keywords
'
 Dim olInboxItems As Outlook.Items
 Dim olAppSession As Outlook.NameSpace
 Dim olInboxFolder As Outlook.MAPIFolder  'use MAPI to loop through folder
 Dim olCalendarFolder As Outlook.MAPIFolder  'use MAPI to loop through folder
 Dim olMessage As Object                  'items in calendar/inbox are messages
 Dim olInboxMessages As Object
 Dim strUserKeyword As String
 Dim messages_seen As Integer
 
 Set olAppSession = Application.Session
 Set olInboxFolder = olAppSession.GetDefaultFolder(olFolderInbox)
 
 strUserKeyword = InputBox("Enter the keyword to remove, or enter * to remove all keywords")
 
 Set olInboxMessages = olInboxFolder.Items
 messages_seen = inbox_loop(olInboxMessages, strUserKeyword)
' MsgBox "Changed " & messages_seen & " messages with keywords in the inbox"
 
 Set olCalendarFolder = olAppSession.GetDefaultFolder(olFolderCalendar)
 Set olInboxMessages = olCalendarFolder.Items
 messages_seen = inbox_loop(olInboxMessages, strUserKeyword)
 'MsgBox "Changed " & messages_seen & " messages with keywords in the inbox"
 
 Set olInboxItems = Nothing     'Cleanup and exit
 Set olInboxFolder = Nothing
 Set olCalendarFolder = Nothing
 Set olAppSession = Nothing
 
End Sub
 
Public Function inbox_loop(olInboxMessages, strUserKeyword)
'
' loop through each message in the inbox and reset keywords
'
 Dim olMessage As Object
 Dim num_changed As Integer
    num_changed = 0
    For Each olMessage In olInboxMessages
       If olMessage.Categories = strUserKeyword Or _
          (strUserKeyword = "*" And Len(olMessage.Categories) > 0) Then
            olMessage.Categories = ""    ' Sets the categories to nothing
            olMessage.Save               ' Saves the message
            num_changed = num_changed + 1
       End If
   Next
   inbox_loop = num_changed
End Function