我正在尝试从 GAL 更新联系人列表。
更新联系人列表的系统是我的宏删除给定文件夹中的所有联系人，然后从 GAL 添加联系人，其中联系人始终是最新的。这会产生一个问题，如果您向联系人添加家庭住址或个人电话，一旦您更新联系人列表，就会丢失它们。
我有一个宏可以在 GAL 中查找符合特定要求（我们的办公地点）的联系人。
现在棘手的部分
如果联系人（基于全名）已经在我的联系人列表中，那么我想更新所有公司专用字段（例如：公司名称、职位等），但保留所有其他字段不变。
如果联系人不在我的联系人列表中：添加 - 工作
如果我的联系人列表中的联系人未与 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