Automatically Categorise Email on Microsoft Outlook
Automatically add category to incoming email or outgoing email based on
- Sender,
- Subject, or
- Domain
Setup Steps:
Add VBA Project to Outlook
Create different files as showing in the image below
Enable Macros
You have to enable all macros as shown below
Modify per your need
Update Modules/AutoCategorized.vb file to fit your need
Public Sub AddSenders()
Set KnownSenders = New Dictionary
KnownSenders.Add "[email protected]", "Help"
KnownSenders.Add "[email protected]", "DNR"
End Sub
Public Sub AddSubjectLines()
Set KnownSubjectLines = New Dictionary
KnownSubjectLines.Add "Subject line", "SL"
End Sub
Public Sub AddDomainNames()
Set KnownDomains = New Dictionary
KnownDomains.Add "twitter.com", "Tweet"
KnownDomains.Add "gmail.com", "Gmail"
End SubTest it out
In this file, Modules/AutoCategorized.vb, you will find the section below. Click inside the Sub and Run (F5) it. You will notice the categories will be added Note: To see the colors on category, you have to restar the Outlook.
'' ****************************************
'' - - - - - - - - - - - - - - - - - - - -
''
'' TEST SUBS
''
'' - - - - - - - - - - - - - - - - - - - -
'' ****************************************
Public Sub ApplyCategoriesToAllInboxItems()
Dim objNS As Outlook.NameSpace: Set objNS = GetNamespace("MAPI")
Dim olFolder As Outlook.MAPIFolder
Set olFolder = objNS.GetDefaultFolder(olFolderInbox)
Dim Item As Object
' Initialize the list of known doamin dictionary
AddDomainNames
' Initialize the list of known subject lines
AddSubjectLines
' Initialize the list of the know senders list
AddSenders
For Each Item In olFolder.Items
If Item.Class = olMail _
Or Item.Class = olMeetingReceived Then
OutlookItemReceivedOrSent Item
End If
Next
MsgBox "Done"
End SubRestart Outlook
Once above two setps are done, restart outlook.
Run PowerShell when conditions are right
If you need to do some external work based on the email you received or sent, you can do something like below to automate
Public Sub RunPowerSheelToInstallApplications(emailAddresses As Collection, emailItem As Object)
Dim email As Variant
For Each email In emailAddresses
Dim emailAddress As String: emailAddress = CStr(email)
If ValidEmail(emailAddress) _
And emailAddress = "[email protected]" _
And InStr(emailItem.Subject, "SubjectContains") Then
'Run power shell
Dim ps As Variant
ps = Shell("POWERSHELL.exe -noexit " & _
"""D:\..\..\PowerShell\MyPowerShell.ps1""", 1)
End If
Next
End Sub
React
Typescript
Django
Laravel
Facebook
Microsoft
Google
Alibaba
D3
Tencent