Access VBA code for Outlook Object Library - look up name & manager

Using Microsoft Acess 2003, VBA coding on Windows XP Professional with Microsoft Outlook 11.0 Object Library.

Trying to find the VBA code to (1) look up a person's name in the address book (2) look up the person's manager as I wish to CC the manager.    

Started with:

  Dim MyOutlook As Outlook.Application
  Dim MyMail As Outlook.MailItem
  Dim MyRecipient As Outlook.Recipient
  Dim MyAddressList As Outlook.AddressLists
  Dim MyAddressEntry As Outlook.AddressEntry
  Set MyOutlook = New Outlook.Application
  Set MyMail = MyOutlook.CreateItem(olMailItem)

Who is Participating?
Chris BottomleyConnect With a Mentor Software Quality Lead EngineerCommented:
Assuming you are happy that the entries in the contacts folder are consistent, i.e. that manager names against a contact represent the string used for the manager name ... or that you have a field for each contact with the manager email, (let me know if it's unclear how to change) then the following works during a trial with dummy data so should give you what you want:

Sub read_contact()
Dim MyOutlook  As Outlook.Application
Dim outlook_namespace As NameSpace
Dim outlook_contacts As MAPIFolder
Dim con As Outlook.ContactItem
Dim manager_name As String
Dim manager_email As String

    Set MyOutlook  = GetObject(, "outlook.application")
    If MyOutlook  Is Nothing Then Set MyOutlook  = CreateObject("outlook.application")
    Set outlook_namespace = outlook_app.GetNamespace("MAPI")
    Set outlook_contacts = outlook_namespace.GetDefaultFolder(olFolderContacts)
    For Each con In outlook_contacts.Items
        If con.FullName = recipient_name Or con.Email1Address = recipient_email Then
            manager_name = con.ManagerName
        End If
    For Each con In outlook_contacts.Items
        If con.FullName = manager_name Then
            manager_email = con.Email1Address
        End If
End Sub

MrLoginAuthor Commented:
Thanks Chris.

Your response provided sufficient insight to solve the problem, have included the test harness I used for completeness - points to you.


Sub Test_mail()

  Dim MyOutlook As outlook.Application
  Dim MyNameSpace As NameSpace
  Dim MyAddrList As AddressList
  Dim MyDistList As AddressEntry
  Dim MyListMember As AddressEntry
  Dim MyMail As outlook.MailItem
  Dim MyRecipient As outlook.Recipient
  Dim sUserName As String
  ' ---- Connect to Outlook
  Set MyOutlook = New outlook.Application
  Set MyNameSpace = MyOutlook.GetNamespace("MAPI")
  Set MyAddrList = MyNameSpace.AddressLists("Global Address List")
  ' ---- User name parameter
  sUserName = GetUserNameFromForm()
  ' ---- Set up mail item & resolve supplied name
  Set MyMail = MyOutlook.CreateItem(olMailItem)
  MyMail.Recipients.Add (sUserName)
  Set MyRecipient = MyMail.Recipients.Item(1)
  If Not MyRecipient.Resolved Then
    MsgBox "Please choose a valid name"
    Exit Sub
  End If
  ' ---- What is available in the distribution list
  Set MyDistList = MyAddrList.AddressEntries(MyRecipient.Name)
  ' ---- CC the manager if present
  If Not MyDistList.Manager Is Nothing Then
    MyMail.CC = MyDistList.Manager
  End If
  ' ---- Resolve a single entry or a distribution list
  If MyDistList.Members Is Nothing Then
    MsgBox MyDistList.Name & ", " & IIf(Not MyDistList.Manager Is Nothing, MyDistList.Manager, "")
     For Each MyListMember In MyDistList.Members
       MsgBox MyListMember.Name & ", " & IIf(Not MyListMember.Manager Is Nothing, MyListMember.Manager, "")
  End If
  MyMail.Subject = "Subject line"
  MyMail.Body = "Multiple line " & vbCrLf & "body"
  Set MyListMember = Nothing
  Set MyDistList = Nothing
  Set MyRecipient = Nothing
  Set MyMail = Nothing
  Set MyAddrList = Nothing
  Set MyNameSpace = Nothing
  Set MyOutlook = Nothing

End Sub
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.