如何根据 Excel (VBA) 中的值从 Outlook 地址簿中提取

How to pull from Outlook Address book based on values in Excel (VBA)

提问by SimaPro

I have the following code that works (I found it on a forum):

我有以下有效的代码（我在论坛上找到了它）：

Public Sub GetUsers()
Dim myolApp As Outlook.Application
Dim myNameSpace As Namespace
Dim myAddrList As AddressList
Dim myAddrEntries As addressEntry
Dim AliasName As String
Dim i As Integer, r As Integer
Dim EndRow As Integer, n As Integer
Dim myStr As String, c As Range
Dim myPhone As String
'Dim propertyAccessor As Outlook.propertyAccessor  'This only works with 2007 and may help you out

Set myolApp = CreateObject("Outlook.Application")
Set myNameSpace = myolApp.GetNamespace("MAPI")
Set myAddrList = myNameSpace.addressLists("Global Address List")

Dim FullName As String, LastName As String, FirstName As String
Dim StartRow As Integer

EndRow = Cells(Rows.Count, 3).End(xlUp).Row

StartRow = InputBox("At which row should this start?", "Start Row", 4)

For Each c In Range("A" & StartRow & ":A" & CStr(EndRow))
    AliasName = LCase(Trim(c))
    c = AliasName
    Set myAddrEntries = myAddrList.addressEntries(AliasName)

    FullName = myAddrEntries.Name
    FirstName = Trim(Mid(FullName, InStr(FullName, "(") + 1, _
                    InStrRev(FullName, " ") - InStr(FullName, "(")))
    LastName = Right(FullName, Len(FullName) - InStrRev(FullName, " "))
    LastName = Left(LastName, Len(LastName) - 1)

    c.Offset(0, 1) = FirstName
    c.Offset(0, 2) = LastName
    c.Offset(0, 3) = FirstName & " " & LastName
Next c
End Sub

When I provide a single name (first or last) it looks for it in the address book and returns the first and last names of the person it found.

当我提供一个名字（名字或姓氏）时，它会在地址簿中查找它并返回它找到的人的名字和姓氏。

I want to provide the enterprise ID of the person, have it look for that and then return other information (location, phone number etc).

我想提供此人的企业 ID，让它查找，然后返回其他信息（位置、电话号码等）。

I can't figure out how to do that. First of all, I don't know how outlook knows to search only Alias, as far as I can tell that's only declared in local variables. Also, when I try to pull out other information, for example:

我不知道该怎么做。首先，我不知道 Outlook 如何知道只搜索别名，据我所知，它只在局部变量中声明。另外，当我尝试提取其他信息时，例如：

HomeState = myAddrEntries.HomeState

I get an error: Object doesn't support this property or method. I don't know what that property would be called - I couldn't find any doc online that showed how properties are named (even when I searched for MAPI docuemntation).

我收到错误消息：对象不支持此属性或方法。我不知道该属性将被称为什么 - 我在网上找不到任何显示属性如何命名的文档（即使我搜索了 MAPI 文档）。

SO, my question is - how can I use this code to search by ID and return other properties such as location, number etc. ALso - how can I generalize that process - is there a list of what those field names are called, is there a way to generate a list?

所以，我的问题是 - 我如何使用此代码按 ID 搜索并返回其他属性，例如位置、数字等。另外 - 我如何概括该过程 - 是否有这些字段名称的列表，是否存在一种生成列表的方法？

Thanks!

谢谢！

回答by David Zemens

Let's see if this can help you out. I am not an expert with Outlook VBA but it is mostly the same, and just a matter of finding the documentation.

让我们看看这是否可以帮助您。我不是 Outlook VBA 的专家，但它大致相同，只是查找文档的问题。

Bookmark this page:

收藏此页：

http://msdn.microsoft.com/en-us/library/office/ff870566(v=office.14).aspx

http://msdn.microsoft.com/en-us/library/office/ff870566(v=office.14).aspx

Specifically then you could look at the entry for AddressEntryobject:

具体来说，您可以查看AddressEntry对象的条目：

http://msdn.microsoft.com/en-us/library/office/ff870588(v=office.14).aspx

http://msdn.microsoft.com/en-us/library/office/ff870588(v=office.14).aspx

And from there you can see the list of available properties/methods. I believe that should answer your second question, I get an error: Object doesn't support this property or method. I don't know what that property would be called.

从那里您可以看到可用属性/方法的列表。我相信应该回答你的第二个问题，我收到一个错误：对象不支持这个属性或方法。我不知道该属性将被称为什么。

Homestateis not a property of an AddressEntryobject.

Homestate不是AddressEntry对象的属性。

When I provide a single name (first or last) it looks for it in the address book and returns the first and last names of the person it found.

当我提供一个名字（名字或姓氏）时，它会在地址簿中查找它并返回它找到的人的名字和姓氏。

Do not expect this to be 100% reliable

不要指望这是 100% 可靠的

I tested this with 6 names and it got 4 of them right. 3 were rare last names. One was a full name which surprisingly returned wrong results. Your mileage may vary.

我用 6 个名字对此进行了测试，其中 4 个是正确的。3 是罕见的姓氏。一个是一个全名，它出人意料地返回了错误的结果。你的旅费可能会改变。

This will not work for any large organization. If you have a small address list, then perhaps it is easy to uniquely resolve based on a simple first/last name string. But otherwise, this is not reliable.

这不适用于任何大型组织。如果您有一个小的地址列表，那么基于简单的名字/姓氏字符串可能很容易进行唯一解析。但除此之外，这是不可靠的。

You have a few questions:

你有几个问题：

I want to provide the enterprise ID of the person, have it look for that and then return other information (location, phone number etc).

我想提供此人的企业 ID，让它查找，然后返回其他信息（位置、电话号码等）。

I do not think this is how Outlook resolves email addresses from an alias. You will need to reference some external database to perform a query like that.

我认为这不是 Outlook 从别名解析电子邮件地址的方式。您将需要引用一些外部数据库来执行这样的查询。

I don't know how outlook knows to search only Alias, as far as I can tell that's only declared in local variables.

我不知道 Outlook 如何知道只搜索别名，据我所知，它只在局部变量中声明。

AliasNamewas a local variable in the example code, but it is assigned a value from user-input (cells in an Excel spreadsheet, for example). So the macro is reading in some values and attempting to resolve them against the address book.

AliasName在示例代码中是一个局部变量，但它从用户输入（例如 Excel 电子表格中的单元格）中分配了一个值。所以宏正在读取一些值并尝试根据地址簿解析它们。

As I mentioned above, this is only as good as the likelihood that a simple string will uniquely resolve to the correctindividual.

正如我上面提到的，这仅与简单字符串唯一解析为正确个体的可能性一样好。

Also, when I try to pull out other information, for example:

HomeState = myAddrEntries.HomeState

I get an error: Object doesn't support this property or method. I don't know what that property would be called - I couldn't find any doc online that showed how properties are named (even when I searched for MAPI docuemntation).

另外，当我尝试提取其他信息时，例如：

HomeState = myAddrEntries.HomeState

我收到错误消息：对象不支持此属性或方法。我不知道该属性将被称为什么 - 我在网上找不到任何显示属性如何命名的文档（即使我搜索了 MAPI 文档）。

Can there be a better solution???

有没有更好的解决办法？？？

Yes. Yes, there can.

是的。是的，可以。

If you dig around in the object model, you will find two items that look promising, GetContactmethod which returns a ContactItem(unfortunately this is not what we want), and GetExchangeUserwhich returns an ExchangeUser. I think this is the closest to what you want, since it contains much of the information you are looking for.

如果你深入研究对象模型，你会发现两个看起来很有希望的项目，GetContact方法返回一个ContactItem（不幸的是这不是我们想要的），GetExchangeUser一个返回一个ExchangeUser. 我认为这是最接近您想要的，因为它包含您正在寻找的大部分信息。

http://msdn.microsoft.com/en-us/library/office/ff870767(v=office.14).aspx

http://msdn.microsoft.com/en-us/library/office/ff870767(v=office.14).aspx

I modify your code as follows:

我修改你的代码如下：

Option Explicit

Public Sub GetUsers()

Dim myolApp As Outlook.Application
Dim myNameSpace As Namespace
Dim myAddrList As AddressList
Dim myAddrEntry As addressEntry   'I changed this variable to avoid ambiguity
Dim AliasName As String
Dim i As Integer, r As Integer
Dim c As Range
Dim EndRow As Integer, n As Integer
Dim exchUser As Outlook.ExchangeUser

Set myolApp = CreateObject("Outlook.Application")
Set myNameSpace = myolApp.GetNamespace("MAPI")
Set myAddrList = myNameSpace.addressLists("Global Address List")

Dim FullName As String, LastName As String, FirstName As String
Dim HomeState As String, PhoneNum As String
Dim StartRow As Integer

EndRow = Cells(Rows.Count, 3).End(xlUp).Row

StartRow = InputBox("At which row should this start?", "Start Row", 4)

For Each c In Range("A" & StartRow & ":A" & CStr(EndRow))
    AliasName = LCase(Trim(c))
    c = AliasName
    Set myAddrEntry = myAddrList.addressEntries(AliasName)
    Set exchUser = myAddrEntry.GetExchangeUser

    If Not exchUser Is Nothing Then
        FirstName = exchUser.FirstName
        LastName = exchUser.LastName
        HomeState = exchUser.StateOrProvince
        PhoneNum = exchUser.BusinessTelephoneNumber
        'etc...
    End If

Next c
End Sub

回答by EgoSumAI

To dramatically improve Outlook's reliability of looking up AliasName, especially in a large organization, I would cut off everything after last name and first name, such as department designation. This will work perfectly as long as no contacts are selected who share exact first and last names. No need to lowercase. Change this line:

为了显着提高 Outlook 查找 AliasName 的可靠性，尤其是在大型组织中，我会切断姓氏和名字之后的所有内容，例如部门名称。只要没有选择共享确切名字和姓氏的联系人，这将完美地工作。不需要小写。改变这一行：

Set myAddrEntries = myAddrList.addressEntries(AliasName)

into:

进入：

' Let's cut off everything after "last name, firstname " 
' get position of second blank in string

Dim Pos As Long

Pos = InStr(1, AliasName, " ", vbTextCompare)
Pos = InStr(Pos + 1, AliasName, " ", vbTextCompare)

If Pos > 0 Then
    Set myAddrEntry = myAddrList.addressEntries(Mid(AliasName, 1, Pos - 1))
Else
    Set myAddrEntry = myAddrList.addressEntries(AliasName)
End If

This may not be a complete answer to your question, but it's still an important part of the solution.

这可能不是您问题的完整答案，但它仍然是解决方案的重要组成部分。

回答by Dmitry Streblechenko

Firstly, to resolve against all address books, use Namespace.CreateRecipient(e.g. Application.Session.CreateRecipient) / Recipient.Resolve- if it returns true, Recipient.AddressEntrywill (at the very least) contain valid AddressEntry.Nameand Addressproperties (see AddressEntryobject on MSDN). If the AddressEntry.AddressEntryUserTypeproperty is 0(olExchangeUserAddressEntry), you can use AddressEntry.GetExchangeUsermethod that returns an instance of the ExchangeUserobject. In your case, the property you want is StateOrProvince.

首先，要针对所有地址簿进行解析，请使用Namespace.CreateRecipient(eg Application.Session.CreateRecipient) / Recipient.Resolve- 如果它返回 true，Recipient.AddressEntry则（至少）将包含有效AddressEntry.Name和Address属性（请参阅MSDN 上的AddressEntry对象）。如果AddressEntry.AddressEntryUserType属性是0( olExchangeUserAddressEntry)，则可以使用AddressEntry.GetExchangeUser返回ExchangeUser对象实例的方法。在您的情况下，您想要的属性是StateOrProvince。

If the address entry corresponds to one of the items in the Contacts folder, AddressEntry.AddressEntryUserTypewill be 10(olOutlookContactAddressEntry) and you can use the AddressEntry.GetContact()method to get an instance of the corresponding ContactItemobject.

如果地址条目对应于在联系人文件夹中的项目之一，AddressEntry.AddressEntryUserType将是10（olOutlookContactAddressEntry），你可以使用AddressEntry.GetContact()的方法来得到相应的实例ContactItem对象。

Keep in mind that if there are multiple matches, Outlook Object Model will throw an exception, there is no way to get the list of potential matches similar to the "Duplicate Names" dialog in Outlook unless you use Extended MAPI (C++ or Delphi only) or Redemption(any language). If using Redemption is an option, it exposes RDOAddressBook.ResolveNameExand RDOAddressList.ResolveNameExmethods, which return a list of matches either against the whole address book (RDOSession.AddressBook.ResolveNameEx) or just the GAL container (RDOSession.AddressBook.GAL.ResolveNameEx):

请记住，如果有多个匹配项，Outlook 对象模型将抛出异常，除非您使用扩展 MAPI（仅限 C++ 或 Delphi），否则无法获取类似于 Outlook 中“重复名称”对话框的潜在匹配项列表或救赎（任何语言）。如果使用 Redemption 是一个选项，它会公开RDOAddressBook。ResolveNameEx和RDOAddressList。ResolveNameEx方法，返回匹配整个地址簿 ( RDOSession.AddressBook.ResolveNameEx) 或仅 GAL 容器 ( RDOSession.AddressBook.GAL.ResolveNameEx)的匹配列表：

set Session = CreateObject("Redemption.RDOSession")
Session.MAPIOBJECT = Application.Session.MAPIOBJECT
set AdrrEntries = Session.AddressBook.ResolveNameEx("john")
for each AE in AdrrEntries
  MsgBox(AE.Name)
next

回答by JS20'07'11

Straight up taking Microsofts code and adapting it to my excel sheet:

直接采用 Microsoft 的代码并将其调整到我的 excel 表中：

Sub DemoAE()

Dim colAL As outlook.AddressLists
Dim oAL As outlook.AddressList
Dim colAE As outlook.AddressEntries
Dim oAE As outlook.AddressEntry
Dim oExUser As outlook.ExchangeUser
Dim ws As Worksheet
Dim r As range
Set ws = application.ActiveWorkbook.Worksheets("Users")
Set r = ws.range("A2")
Set colAL = outlook.application.Session.AddressLists
TurnOff 'A function that turnsoff a bunch of memory hogging aspects of Excel when doing loops in sheets.

For Each oAL In colAL

'Address list is an Exchange Global Address List

If oAL.AddressListType = olExchangeGlobalAddressList Then
    Set colAE = oAL.AddressEntries
    For Each oAE In colAE
    If oAE.AddressEntryUserType = olExchangeUserAddressEntry Then
    Set oExUser = oAE.GetExchangeUser
        If oExUser.Alias <> "" And oExUser.PrimarySmtpAddress <> "" And oExUser.FirstName <> "" Then

            r = (oExUser.FirstName)
            r.Offset(0, 1) = (oExUser.LastName)
            r.Offset(0, 2) = (oExUser.Alias)
            r.Offset(0, 3) = (oExUser.PrimarySmtpAddress)
            If InStr(1, oExUser.Department, ",") <> 0 Then
                r.Offset(0, 4) = Left(oExUser.Department, InStr(1, oExUser.Department, ",") - 1)
            Else: r.Offset(0, 4) = oExUser.Department
            End If
        Set r = r.Offset(1, 0)
        End If
    End If
    Next

End If

Next
TurnOn 'A function that turns on a bunch of memory hogging aspects of Excel when not doing loops in sheets.

End Sub