Обновить контакты в папке контактов из GAL

Question

Я пытаюсь обновить список контактов из GAL.

Система для обновления списка контактов состоит в том, что мой макрос удаляет все контакты в данной папке, а затем добавляет контакты из GAL, где контакты всегда актуальны. Это создает проблему: если вы добавляете домашний адрес или личный телефон к контакту, вы теряете его после обновления списка контактов.

У меня есть макрос, чтобы искать в GAL контакты, которые соответствуют определенным требованиям (расположение нашего офиса).

Теперь сложная часть

1. Если контакт (на основе полного имени) уже есть в моем списке контактов, я хочу обновить все выделенные поля компании (например, название компании, должность и т. Д.), НО оставить все остальные поля такими, какие они есть.

2. Если контакта нет в моем списке контактов: добавьте его - РАБОТАЕТ

3. Если контакт в моем списке контактов не сопоставлен ни с чем из GAL (означает, что человек покинул компанию), тогда удалите все выделенные поля компании (как в 1).

Мой код (добавляет контакт в зависимости от местоположения)

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

Answer 1

Посмотрите на это с другой стороны, сопоставьте записи в вашем списке контактов с GAL https://msdn.microsoft.com/en-us/library/office/ff869448.aspx.

Set myAddressEntry = myAddressList.AddressEntries(index)

Здесь также принимается строка, поэтому вместо индекса передается строка, которую вы видите в (отображаемом) имени, чтобы вернуть совпадение или закрыть запись, если совпадения нет.