使用高级查找从 Outlook 通讯簿中提取联系人信息

Question

我使用此代码从全局联系人列表中的姓名列表中提取信息。

通常有重复的名称，然后代码无法确定谁是正确的联系人，因此它会跳过它们。我正在尝试将结果缩小到仅使用我网站的名称，如果联系人不是来自该站点(这意味着他们不应该出现在搜索中(，请跳过它并返回到异地到他们的行。

我想使用 Outlook 通讯簿的高级查找功能执行此操作，我可以在其中输入名字、姓氏和城市。有没有办法修改代码以使用高级查找而不是常规查找？

Sub GetOutlookInfo()
Dim I As Integer
Dim ToAddr As String
Dim ActivePersonVerified As Boolean
Dim ol As Outlook.Application
Dim DummyEMail As MailItem
Dim ActivePersonRecipient As Recipient
Dim oAE As Outlook.AddressEntry
Dim oExUser As Outlook.ExchangeUser
Dim oPA As Outlook.PropertyAccessor
Dim AliasRange As Range
Dim RowsInRange As Integer
'Instantiate Outlook
Set ol = CreateObject("Outlook.Application")
'E-mail aliases are in a named range "aliasrange"
'Assign the named range to a range object
Set AliasRange = Range("A1:A1000")
'Create a dummy e-mail to add aliases to
Set DummyEMail = ol.CreateItem(olMailItem)
RowsInRange = AliasRange.Rows.Count
'Loop through the aliases to retrieve the Exchange data
For I = 3 To RowsInRange
'Assign the current alias to a variable ToAddr
ToAddr = AliasRange.Cells(I, 1)
'Exit loop
If ToAddr = "" Then
Exit For
End If
'Use the alias to create a recipient object and add it to the dummy e-mail
Set ActivePersonRecipient = DummyEMail.Recipients.Add(ToAddr)
ActivePersonRecipient.Type = olTo
'Resolve the recipient to ensure it is valid
ActivePersonVerified = ActivePersonRecipient.Resolve
'If valid, use the  AddressEntry property of the recipient to return an AddressEntry object
If ActivePersonVerified Then
Set oAE = ActivePersonRecipient.AddressEntry
'Use the GetExchangeUser method of the AddressEntry object to retrieve the ExchangeUser object for the recipient.
Set oExUser = oAE.GetExchangeUser
'Write the properties of the  ExchangeUser object to adjacent columns on the worksheet.
AliasRange.Cells(I, 1).Offset(0, 1).Value = oExUser.Name 
AliasRange.Cells(I, 1).Offset(0, 2).Value = oExUser.Manager
AliasRange.Cells(I, 1).Offset(0, 3).Value = oExUser.Department
AliasRange.Cells(I, 1).Offset(0, 4).Value = oExUser.JobTitle
AliasRange.Cells(I, 1).Offset(0, 5).Value = oExUser.OfficeLocation
AliasRange.Cells(I, 1).Offset(0, 6).Value = oExUser.City
AliasRange.Cells(I, 1).Offset(0, 7).Value = oExUser.StateOrProvince
AliasRange.Cells(I, 1).Offset(0, 8).Value = oExUser.StreetAddress
AliasRange.Cells(I, 1).Offset(0, 9).Value = oExUser.Alias
End If
'Remove the recipient from the e-mail
ActivePersonRecipient.Delete
Next I
ExitOutlookEmail:
Set DummyEMail = Nothing
Set ol = Nothing
End Sub

Answer 1

Outlook 不允许您访问不明确的名称。名称要么唯一解析，要么由于任何其他原因(未找到或不明确(而失败。