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

Question

我有以下代码(我在论坛上找到它):

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

当我提供单个名称(第一个或最后一个)时,它会在地址簿中查找它并返回它找到的人的名字和姓氏.

我想提供该人的企业ID,让它寻找,然后返回其他信息(位置,电话号码等).

我无法弄清楚如何做到这一点.首先,我不知道outlook如何只搜索Alias,据我所知,它只在局部变量中声明.此外,当我尝试提取其他信息时,例如:

HomeState = myAddrEntries.HomeState

我收到一个错误:对象不支持此属性或方法.我不知道该属性会被调用 - 我找不到任何在线文档,显示属性的命名方式(即使我搜索了MAPI docuemntation).

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

谢谢!

Answer 1

让我们看看这是否可以帮到你.我不是Outlook VBA的专家,但它大致相同,只是找到文档的问题.

收藏此页:

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

具体来说,你可以查看AddressEntry对象的条目:

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

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

Homestate不是AddressEntry对象的属性.

当我提供单个名称(第一个或最后一个)时,它会在地址簿中查找它并返回它找到的人的名字和姓氏.

不要指望这是100%可靠的

我用6个名字对它进行了测试,其中有4个正确.3是罕见的姓氏.一个是一个全名,令人惊讶地返回了错误的结果.你的旅费可能会改变.

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

你有几个问题:

我想提供该人的企业ID,让它寻找,然后返回其他信息(位置,电话号码等).

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

我不知道outlook如何只搜索Alias,据我所知,它只在局部变量中声明.

AliasName是示例代码中的局部变量,但它从用户输入(例如,Excel电子表格中的单元格)中分配了一个值.因此,宏正在读取某些值并尝试根据地址簿解析它们.

正如我上面提到的,这仅仅是一个简单的字符串将唯一地解析为正确的个体的可能性.

此外,当我尝试提取其他信息时,例如:

HomeState = myAddrEntries.HomeState

我收到一个错误:对象不支持此属性或方法.我不知道该属性会被调用 - 我找不到任何在线文档,显示属性的命名方式(即使我搜索了MAPI docuemntation).

可以有更好的解决方案???

是.是的,有.

如果你在对象模型中挖掘,你会发现两个看起来很有前途的项目,GetContact返回一个方法ContactItem(遗憾的是这不是我们想要的),并GetExchangeUser返回一个ExchangeUser.我认为这是最接近你想要的,因为它包含你正在寻找的大部分信息.

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

我修改你的代码如下:

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