To update the Companies field with data from a linked contact

All Outlook items have a property -- Contacts in the user interface, Links in the object model -- that allows you to relate the item to one or more contact records in any contacts folder. Many Outlook items also have a Companies or Company property. You might think that Companies would fill in automatically with the data from a linked contact. It does on a task or appointment, but not on a journal item (see Notes below). This code takes care of that with routines that use the ItemAdd and ItemChange events on the Journal folder's Items collection to update the Companies field to either be blank if Contacts is blank or show one company name if there is one link in Contacts.

To try this code, paste it into the built-in ThisOutlookSession module in VBA in Outlook 2000 or later.

Code Sample

Public WithEvents colJournal As Items Dim mblnUpdatingCompany As Boolean Private Sub Application_Startup() Dim objNS As NameSpace Set objNS = Application.GetNamespace("MAPI") Set colJournal = objNS.GetDefaultFolder(olFolderJournal).Items Set objNS = Nothing End Sub Private Sub colJournal_ItemAdd(ByVal Item As Object) Dim objJ As JournalItem If Item.Class = olJournal Then Set objJ = Item Call UpdateCompaniesWithLink(objJ) End If Set objJ = Nothing End Sub Private Sub colJournal_ItemChange(ByVal Item As Object) Dim objJ As JournalItem If Not mblnUpdatingCompany Then mblnUpdatingCompany = True If Item.Class = olJournal Then Set objJ = Item Call UpdateCompaniesWithLink(objJ) End If Else mblnUpdatingCompany = False End If Set objJ = Nothing End Sub Sub UpdateCompaniesWithLink(objJournal As JournalItem) Dim colLinks As Links Dim objLink As Link Dim objContact As ContactItem objJournal.Companies = "" Set colLinks = objJournal.Links If colLinks.Count = 1 Then Set objContact = colLinks.Item(1).Item If Not objContact Is Nothing Then objJournal.Companies = objContact.CompanyName End If End If If colLinks.Count < 2 Then objJournal.Save End If Set objContact = Nothing Set objLink = Nothing Set colLinks = Nothing End Sub

Notes

The Companies property of a JournalItem is actually a keywords field. If you use just the colJournal_ItemAdd subroutine and not the colJournal_ItemChange procedure, Outlook will add new names to the Companies field automatically as you change the names listed under Contacts. But it will not remove any names already in Companies.

More Information


	© 2002-7 TurtleFlock, LLC All right reserved. About OutlookCode.com Send comments to webmaster@outlookcode.com Designed and Implemented by TerraLink USA FrontPage Integration by RobsonDesignWorks


get Sue's code \| forums \| share your own code \| registration