Join Appointment Item with Contact Data

This sample demonstrates how to look up a contact you have a meeting with, and display its mailing address with the appointment item.

Last modified: 2015/09/07 | Accessed: 23.699  | #154
◀ Previous sample Next sample ▶
OLKeeper OLKeeper
OLKeeper reliably prevents users from closing their Outlook window and thus possibly missing reminders or e-mails.

You can link any Outlook items with your contacts. So you can add a contact to an appointment item, and if you double click the contact, you could see, for instance, its mailing address. This is useless, however, on the road with your smartphone where the contact linking isn't available.

(Since Outlook 2007 the 'Contacts' field isn't shown by default. Read here how to get the field back.)

With a few lines of VBA code you can copy important information from the contact to the appointment item. That way the information will be available even on the road. This sample copies the mailing address to the 'Location' field if the field is still empty.

After pasting the code into 'ThisOutlookSession', restart Outlook, create an appointment item, and add a name from your contacts folder, then save it. If the contact is found (Outlook will display it underlined), the mailing address will be displayed under 'Location'.

tip  How to add macros to Outlook
Private WithEvents m_Items As Outlook.Items

Private Sub Application_Startup()
  Set m_Items = Application.Session.GetDefaultFolder(olFolderCalendar).Items
End Sub

Private Sub m_Items_ItemAdd(ByVal Item As Object)
  If TypeOf Item Is Outlook.AppointmentItem Then
    AddContactInfo Item
  End If
End Sub

Private Sub m_Items_ItemChange(ByVal Item As Object)
  If TypeOf Item Is Outlook.AppointmentItem Then
    AddContactInfo Item
  End If
End Sub

Private Sub AddContactInfo(Appt As Outlook.AppointmentItem)
  Dim Link As Outlook.Link
  Dim Contact As Outlook.ContactItem
  Dim Adr As String
  Static Busy As Boolean
  If Busy Then Exit Sub Else Busy = True
  If Appt.Location = "" Then
    If Appt.Links.Count Then
      Set Link = Appt.Links(1)
      If Not Link.Item Is Nothing Then
        Set Contact = Link.Item
        If Not Contact Is Nothing Then
          Adr = Contact.MailingAddress
          Adr = Replace(Adr, vbCrLf, ", ")
          If Right$(Adr, 2) = ", " Then
            Adr = Left$(Adr, Len(Adr) - 2)
          End If
          Appt.Location = Adr
        End If
      End If
    End If
  End If
  Busy = False
End Sub
Category-Manager Category-Manager
With Category-Manager you can group your Outlook categories, share them with other users, filter a folder by category, automatically categorize new emails, and more. You can use the Addin even for IMAP.
email  Send a message