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

Question

I use this code to extract information from a list of names from my global contacts list.

There are often duplicate names and the code then cannot decide who is the correct contact so it skips them. I am trying to narrow the results down to only use names from my site and if the contact is not from that site (meaning they should not appear in search), to skip it and return offsite to their row.

I want to do this using the advanced find function of the Outlook address book where I can put in a first name, last name, and city. Is there a way I could modify the code to use advanced find instead of a general find?

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 won't let you access ambiguous names. A name either uniquely resolves, or it fails for whatever other reason (not found or ambiguous).