|Determine the "identity" of your emails. Set with SAM the sender and the folder folder for sent items with the help of rules.|
Via contact activities you can view other items that are linked with the contact, like e-mails, appointments, journal items, etc. If you address an email, the link is automatically created. For all of the other items you need to do that yourself. For that there's a Contacts field at the bottom of each form except for emails. You need to display the options dialog if you want to link an email to another contact that isn't listed as a recipient.
So, as the process is done fairly quickly for most of the items, some more clicks are necessary for emails. Even more effort is necessary if you want to link multiple items with one or more contacts. The following VBA script makes it very easy. Just select one or more items you want to link to one or more contacts, then start the LinkItemToContact procedure, and enter one or more contact names, separated by a comma or semicolon. The condition is that every name can be resolved by Outlook. That means the contact must not have more than one email address. If it has, you must enter the address instead of just the name.
Public Sub LinkItemToContact() Dim c As VBA.Collection Dim obj As Object Dim Links As Outlook.Links Dim Link As Outlook.Link Dim Contacts As VBA.Collection Dim Contact As Outlook.ContactItem Dim i&, y&, z& Dim Names() As String Dim b$ b = Trim$(InputBox("Contacts:")) If Len(b) = 0 Then Exit Sub b = Replace(b, ";", ",") Names = Split(b, ",") Set Contacts = New VBA.Collection For i = 0 To UBound(Names) If Len(Names(i)) Then Set Contact = GetContactByName_Ex(Names(i)) If Not Contact Is Nothing Then Contacts.Add Contact Else MsgBox "Could not resolve '" & Names(i) & _ "'. Try with the email address.", vbInformation Exit Sub End If End If Next Set c = GetCurrentItems For i = 1 To c.Count Set obj = c(i) Set Links = obj.Links For y = 1 To Contacts.Count Set Contact = Contacts(y) If Links.Item(Contact.Subject) Is Nothing Then Links.Add Contact End If Next If obj.Saved = False Then obj.Save End If Next End Sub Private Function GetContactByName_Ex(Name$) As Outlook.ContactItem Dim Folder As Outlook.MAPIFolder Dim Items As Outlook.Items Dim Item As Outlook.ContactItem Dim FindInDefault As Boolean Dim Recip As Outlook.Recipient If Len(Name) = 0 Then Exit Function Set Recip = Application.Session.CreateRecipient(Name) If Not Recip Is Nothing Then If Recip.Resolve Then Set Item = Recip.AddressEntry.GetContact If Not Item Is Nothing Then Set GetContactByName_Ex = Item Exit Function End If End If End If End Function Private Function GetCurrentItems(Optional IsInspector As Boolean _ ) As VBA.Collection Dim c As VBA.Collection Dim Sel As Outlook.Selection Dim obj As Object Dim i& Set c = New VBA.Collection If TypeOf Application.ActiveWindow Is Outlook.Inspector Then c.Add Application.ActiveInspector.CurrentItem Else Set Sel = Application.ActiveExplorer.Selection If Not Sel Is Nothing Then For i = 1 To Sel.Count c.Add Sel(i) Next End If End If Set GetCurrentItems = c End Function
|ReplyAll alerts you before unintentionally replying all, or if you are a confidential BCC recipient of the e-mail.|