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不允许您访问不明确的名称。名称可以唯一地解析，或者由于其他原因（找不到或模棱两可）而失败。

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

1 个答案: