Sub ListSelectionMonth() 'Note need to create a new custom column Month before runnining this script Dim aObj As Object Dim oProp As Outlook.UserProperty Dim sMonth On Error Resume Next For Each aObj In Application.ActiveExplorer.Selection Set oMail = aObj sMonth = Month(oMail.ReceivedTime) Set oProp = oMail.UserProperties.Add("Month", olText, True) oProp.Value = sMonth oMail.Save Err.Clear Next End Sub