Question

根据Outlook 2010中的默认全局地址列表：

为名为“ John Doe”的收件人分配了电子邮件地址“ john@aaa.com”
为名为“ John Doe2”的收件人分配了电子邮件地址“ doe@bbb.com”

如果在[收件人]字段中键入“ John Doe”并按[发送]，则Outlook似乎发现名称“ John Doe”不明确，从而迫使用户选择确切的名称标签（通过[检查]名称]按钮），然后才能实际发送邮件。

我的目标是在了解域名和部分名称的情况下自动选择正确的（1）名称标签或（2）收件人的电子邮件地址。

问题是，我们只知道收件人具有：

“ John Doe”的名字本身无法解决（由于“ John Doe2”）和
特定域（@ aaa.com或@ bbb.com），而不是完整的电子邮件地址。

名称标签“ John Doe2”是未知的，直到以某种方式解决了“ John Doe”。

如果我们了解收件人姓名的域名和部分知识，是否有可能获得：

1）全名（必须解析）或

2）完整的SMTP地址（首选，因为它是明确的）

收件人，这样邮件项就可以发送了？

Dim Email As Outlook.MailItem
Dim domaintype As String                ' domaintype is given
'   domaintype = "@aaa.com"
'   domaintype = "@bbb.com"
Dim recipientname As String             ' recipient name is partially known
'   recipientname = "John Doe"

if domaintype = "@aaa.com" then
    With Email
        ' How do I add the correct recipient?
        .Recipient.Add recipientname    ' SMTP address = john@aaa.com for "John Doe"
    End With
elseif domaintype = "@bbb.com" then
    With Email
        ' How do I add the correct recipient?
        .Recipient.Add recipientname    ' SMTP address = doe@bbb.com for "John Doe2"
    End With
else
    ' do something else
end if

Email.Recipients.ResolveAll     ' "John Doe" is not resolved because it is ambiguous!

Answer 1

Outlook对象模型不允许您静默检索不明确匹配的列表。

在扩展MAPI（C ++或Delphi）中，可以在通讯簿搜索路径中对容器（IABContainer）的内容表使用PR_ANR限制。

如果不能选择扩展MAPI，则可以使用Redemption（我是它的开发人员）-您可以使用RDOAddressBook。ResolveNameEx方法-它返回匹配条目的列表：

set Session = CreateObject("Redemption.RDOSession")
Session.MAPIOBJECT = Application.Session.MAPIOBJECT
set AdrrEntries = Session.AddressBook.ResolveNameEx("John")
Debug.Print AdrrEntries.Count & " names were returned by ResolveNameEx:"
Debug.Print "------------"
for each AE in AdrrEntries
    Debug.Print AE.Name & " " & AE.SMTPAddress
next
Debug.Print "------------"

Answer 2

Option Explicit

Sub AddressEntry_From_Ambiguous_Name()

    ' Please note.
    ' It is not practical to loop through a GAL.
    ' This is for science.

    ' This is a demo for finding names by looping through the GAL.
    ' There is more coding to do if you insist.

    Dim oAL As AddressList
    Dim colAE As AddressEntries
    Dim oAE As AddressEntry
    Dim oExUser As exchangeUser

    Dim i As Long

    Dim maxCount As Long
    Dim testCount As Long
    Dim srchName As String
    Dim candidateName As String

    ' For testing stay near the top of the list
    srchName = "Abc"

    ' This condition is left for you to code
    'srchDomain = "aaa.com"

    Set oAL = Session.AddressLists("Global Address List")

    'Address list is an Exchange Global Address List
    If oAL.AddressListType = olExchangeGlobalAddressList Then

        Set colAE = oAL.AddressEntries

        maxCount = colAE.count

        ' For testing
        testCount = 1000
        If maxCount > testCount Then maxCount = testCount
        ' comment out above two lines to go live

        For i = 1 To maxCount

            ' no distribution lists
            If colAE(i).AddressEntryUserType = olExchangeUserAddressEntry _
              Or colAE(i).AddressEntryUserType = olExchangeRemoteUserAddressEntry Then

                Debug.Print i & " colAE(i).name: " & colAE(i).name

                ' Where name is in Last, First format in the GAL
                ' You can Split at the comma instead.
                candidateName = Left(colAE(i).name, Len(srchName))

                If candidateName = srchName Then

                    Set oExUser = colAE(i).GetExchangeUser

                    If MsgBox((oExUser.PrimarySmtpAddress) & " is this the address.", vbYesNo) = vbYes Then
                        Debug.Print (oExUser.PrimarySmtpAddress) & " found."
                        Debug.Print "Code to replace the recipient, without using MsgBox."
                        Exit For
                    End If

                    DoEvents

                ElseIf candidateName > srchName Then

                    Set oExUser = colAE(i).GetExchangeUser
                    Debug.Print i & " " & oExUser.PrimarySmtpAddress
                    Debug.Print " You have gone past last name " & srchName
                    Debug.Print " Code to delete the recipient then send."
                    Exit For

                End If

            End If

        Next

    End If

End Sub

解决给定SMTP域和部分名称的收件人

2 个答案: