VBA-Excel如何在Outlook中find交换用户的电子邮件地址

我一直在尝试根据input名称导入联系人的电子邮件。 我不擅长macros编程，但发现了一个可行的代码。 但是，它只能通过查找联系人文件夹中的信息来工作，我需要它查找全局地址列表中的联系人，并将与该人员关联的电子邮件还给我。 我已经通过其他职位search，他们都希望从Outlook的每一个接触，并将其粘贴到Excel。 我只想根据input的姓名search一个人的全球通讯录，并让其返回该人的电子邮件地址。

这是我有什么：

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

您可以使用Namespace.CreateRecipient / Recipient.Resolve来将名称parsing为收件人对象的实例，而不是循环访问“联系人”文件夹中的所有项目。 然后可以使用AddressEntry.GetContact将其parsing为ContactItem对象或AddressEntry.GetExchangeUser的实例，以获取ExchangeUser对象的实例：

 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