0
votes

I am trying to update the contact list from the GAL.

The system for updating a contact list is that my macro deletes all the contacts in a given folder then adds contacts from the GAL where the contacts are always up to date. This creates the problem that if you add home address or personal phone to the contact you lose them once you update the contact list.

I have a macro to look in the GAL for contacts that match a specific requirement (our office location).

Now the tricky part

  1. If a contact is (based on full name) already in my contact list then I want to update all company dedicated fields, (such as: Company name, position and so on) BUT to leave all other fields as they are.

  2. If the contact is not in my contact list: Add it - WORKS

  3. If a contact in my contact list has not been matched with anything from the GAL (means the person left the company) then delete all company dedicated fields (same as in 1).

My code (adds a contact based on location)

Sub GetAllGALMembers()

Dim olApp As Outlook.Application
Dim olNS As Outlook.NameSpace
Dim olGAL As Outlook.AddressList
Dim olEntry As Outlook.AddressEntries
Dim olMember As Outlook.AddressEntry
Dim objItem As Outlook.ContactItem

Dim myContacts As Outlook.MAPIFolder
Dim myFolder As MAPIFolder
Dim myItems As Items

Set mySession = New Outlook.Application
Set myNS = mySession.GetNamespace("MAPI")
Set myContacts = myNS.GetDefaultFolder(olFolderContacts)
Set myFolder = myContacts.Folders("Prague")
Set myItems = myFolder.Items

Set olApp = Outlook.Application
Set olNS = olApp.GetNamespace("MAPI")
Set olGAL = olNS.GetGlobalAddressList()

Set olEntry = olGAL.AddressEntries
On Error Resume Next
' loop through dist list and extract members

Dim i As Long

For i = 1 To olEntry.Count

  Set olMember = olEntry.Item(i)

  If olMember.AddressEntryUserType = olExchangeUserAddressEntry Then

    strLocation = olMember.GetExchangeUser.OfficeLocation

    If strLocation = "PRG" Then

      Set objItem = olApp.CreateItem(olContactItem)

      With objItem

       .firstName = olMember.GetExchangeUser.firstName
       .Last = olMember.GetExchangeUser.lastName
       .FullName = olMember.GetExchangeUser.Name
       .Email1Address = olMember.GetExchangeUser.PrimarySmtpAddress
       .BusinessTelephoneNumber = olMember.GetExchangeUser.BusinessTelephoneNumber
       .MobileTelephoneNumber = olMember.GetExchangeUser.MobileTelephoneNumber
       .CompanyName = olMember.GetExchangeUser.CompanyName
       .Email2DisplayName = olMember.GetExchangeUser.DisplayType

       .Save

      End With

    End If

  End If

Next i

End Sub
1

1 Answers

0
votes

Look at this from the other side, match entries in your contact list to the GAL https://msdn.microsoft.com/en-us/library/office/ff869448.aspx.

Set myAddressEntry = myAddressList.AddressEntries(index)

This also accepts a string so instead of an index pass the string you see in (display) name to get back a match or a close entry if there is no match.