VBA-Excel 如何在 Outlook 中查找 Exchange 用户的电子邮件地址

Question

我一直在尝试根据输入名称导入联系人的电子邮件。我不太擅长宏编程，但找到了一个有效的代码。然而，它只能通过查找联系人文件夹中的信息来工作，我需要它来查找全局地址列表中的联系人，将与该人关联的电子邮件返回给我。我搜索了其他帖子，他们都想从 Outlook 中获取每个联系人并将其粘贴到 excel。我只想根据输入的姓名搜索一个人的全局地址列表，并让它返回该人的电子邮件。

这是我所拥有的：

Function GrabContactInfo(rRng As Range, iWanted As Integer) As String

Dim olA As Outlook.Application

Dim olNS As Namespace

Dim olAB As MAPIFolder

Dim lItem As Long   

Dim sNameWanted As String

Dim sRetValue As String

Set olA = New Outlook.Application
Set olNS = olA.GetNamespace("MAPI")
Set olAB = olNS.GetDefaultFolder(olFolderContacts)

Application.Volatile
sNameWanted = rRng.Value
sRetValue = "Not Found"

On Error Resume Next

For lItem = 1 To olAB.Items.Count
    With olAB.Items(lItem)
        If sNameWanted = .FullName Then
            Select Case iWanted
                Case 1
                    sRetValue = .CompanyName
                Case 2
                    sRetValue = .BusinessAddress
                Case 3
                    sRetValue = .BusinessAddressCity
                Case 4
                    sRetValue = .BusinessAddressState
                Case 5
                    sRetValue = .BusinessAddressPostalCode
                Case 6
                    sRetValue = .BusinessTelephoneNumber
                Case 7
                    sRetValue = .Email1Address
            End Select
        End If
    End With
Next lItem
olA.Quit
GrabContactInfo = sRetValue
End Function

任何信息都有帮助

Answer 1

您可以使用/将名称解析为 Recipient 对象的实例，而不是遍历Contacts 文件夹中的所有项目。然后，您可以使用将其解析为对象的实例或获取对象的实例：Namespace.CreateRecipientRecipient.ResolveAddressEntry.GetContactContactItemAddressEntry.GetExchangeUserExchangeUser

Set olA = New Outlook.Application
Set olNS = olA.GetNamespace("MAPI")
set olRecip = olNS.CreateRecipient("Dmitry Streblechenko")
olRecip.Resolve
set olAddrEntry = olRecip.AddressEntry
set olCont = olAddrEntry.GetContact
if not (olCont Is Nothing) Then
  'this is a contact
  'olCont is ContactItem object
  MsgBox olCont.FullName
Else
  set olExchUser = olAddrEntry.GetExchangeUser
  if not (olExchUser Is Nothing) Then
    'olExchUser is ExchangeUser object
    MsgBox olExchUser.StreetAddress
  End If
End If