|Determine the "identity" of your emails. Set with SAM the sender and the folder folder for sent items with the help of rules.|
In the folder view Outlook doesn't show e-mail addresses but display names. These display names are often different even for the same recipient, so sorting or grouping by this field is useless.
This macro creates a new field for both the Sent Items folder, and the Inbox, which will hold the pure e-mail addresses. For the Sent Items folder the field is created as a Keyword field so you can group by it like Categories. The name of this new field is 'RecipientAddresses', or 'SenderAddress' for the Inbox, respectively.
Paste the code to the ThisOutlookSession module, and restart Outlook. After you´ve sent or received the next email, the new field will be added to the folder. In order to make the new field then visible in the folder, click View Settings/Columns, switch from 'Frequently-used fields' to 'User-defined fields', and drag the field name to the right. (If you also want to add the field to the emails that already exist in the folder, move the emails to another folder and back.)
Private WithEvents m_Inbox As Outlook.Items Private WithEvents m_SentItems As Outlook.Items Private Sub Application_Startup() Dim Session As Outlook.NameSpace Set Session = Application.Session Set m_Inbox = Session.GetDefaultFolder(olFolderInbox).Items Set m_SentItems = Session.GetDefaultFolder(olFolderSentMail).Items End Sub Private Sub m_Inbox_ItemAdd(ByVal Item As Object) AddAddresses Item, False End Sub Private Sub m_SentItems_ItemAdd(ByVal Item As Object) AddAddresses Item, True End Sub Private Sub AddAddresses(Item As Object, ByVal IsSentMail As Boolean) Dim Recipients As Outlook.Recipients Dim R As Outlook.Recipient Dim UserProps As Outlook.UserProperties Dim Prop As Outlook.UserProperty Dim Adr As String Dim FieldName As String If IsSentMail Then FieldName = "RecipientAddresses" Set Recipients = Item.Recipients For Each R In Recipients Adr = Adr & R.Address & "; " Next If Len(Adr) Then Adr = Left$(Adr, Len(Adr) - 2) End If Else FieldName = "SenderAddress" Adr = Item.SenderEmailAddress End If If Len(Adr) Then Set UserProps = Item.UserProperties Set Prop = UserProps.Find(FieldName, True) If Prop Is Nothing Then If IsSentMail Then Set Prop = UserProps.Add(FieldName, olKeywords, True) Else Set Prop = UserProps.Add(FieldName, olText, True) End If End If Prop.Value = Adr Item.Save End If End Sub
|ReplyAll alerts you before unintentionally replying all, or if you are a confidential BCC recipient of the e-mail.|