在 Excel 中显示 GAL 以获取别名或电子邮件地址

Question

我正在尝试利用THIS POST 中的信息。 我有 2 个问题：

1. 以下行无限期挂起。 FIXED---它只是隐藏并且没有任务栏项目，简单搜索告诉我如何带到前面 strAddress = objWordApp.GetAddress(, strCode, False, 1, , , True, True).GetProperty("http://schemas.microsoft.com/mapi/proptag/0x3A00001E")

2. 我需要返回可以在 TO 行中使用的内容，例如 ALIAS 或完整的电子邮件地址。我已经在 WORD 中测试了这段代码，它可以正常工作（删除对 word 的引用），但我无法获得所需的正确信息。当我拉出时，我得到了一个交换专有名称。我需要以某种方式将其转换为别名或电子邮件地址

/o=corperation/ou=administration/cn=my.name

背景：前面提到的帖子中的代码显示了 OUTLOOK GAL，因此用户可以从中搜索/选择联系人。我想使用 GAL，因为它可以处理 200,000 多条记录并包含分发列表。

软件：这必须在 OFFoffice 2010 套件中运行。我不需要任何 backwords 兼容性，并且未来的校对是目前最小的问题。

结束结果：我基本上只是希望用户能够搜索收件人并将该地址放在单元格中。

任何提示将不胜感激。

Answer 1

方法一：使用GetAddress函数

以下代码是否仍会无限期挂起？

Set objWordApp = CreateObject("Word.Application")
InputBox "", "", objWordApp.GetAddress(, "<PR_EMAIL_ADDRESS>", False, 1, , , True, True)

方法二：知道用户名就直接抢

您可以直接使用LDAP 获取此信息：

Public Function GetUserEmail(ByVal userName As String) As String

    Const ADS_SCOPE_SUBTREE = 2

    Set objConnection = CreateObject("ADODB.Connection")
    Set objCommand = CreateObject("ADODB.Command")
    objConnection.Provider = "ADsDSOObject"
    objConnection.Open "Active Directory Provider"
    Set objCommand.ActiveConnection = objConnection

    objCommand.Properties("Page Size") = 1
    objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE

    objCommand.CommandText = "SELECT mail FROM 'LDAP://DC=something,DC=co,DC=uk' WHERE objectCategory='user' AND sAMAccountName='" & userName & "'"
    Set objRecordSet = objCommand.Execute
    objRecordSet.MoveFirst

    If Not objRecordSet.EOF Then
        GetUserEmail = objRecordSet.Fields("mail").Value
    Else
        GetUserEmail = vbNull
    End If

End Function

方法三：创建自己的可搜索表单

您可以创建自己的用户表单以从 LDAP 中恢复用户列表。您可以选择要搜索的字段，然后允许用户单击该项目以获取电子邮件地址。它有点乱，但它应该加载得更快一些，因为它只会搜索长度超过 3 个字符的名称。

在上面的示例中，我创建了一个查询，用于搜索 LDAP 的 givenName 或 sn 字段：

Private Sub txtSearch_Change()
    If Len(txtSearch) > 3 Then

        queryString = txtSearch

        Const ADS_SCOPE_SUBTREE = 2

        Set objConnection = CreateObject("ADODB.Connection")
        Set objCommand = CreateObject("ADODB.Command")
        objConnection.Provider = "ADsDSOObject"
        objConnection.Open "Active Directory Provider"
        Set objCommand.ActiveConnection = objConnection

        objCommand.Properties("Page Size") = 1
        objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE

        objCommand.CommandText = "SELECT givenName, sn, mail FROM 'LDAP://DC=something,DC=co,DC=uk' WHERE objectCategory='user' AND (givenName = '*" & queryString & "*' Or sn = '*" & queryString & "*')"
        Set objRecordset = objCommand.Execute

        lvResults.ListItems.Clear
        Do Until objRecordset.EOF
            Set li = lvResults.ListItems.Add(, , objRecordset.Fields("givenName").Value)

            li.SubItems(1) = objRecordset.Fields("sn").Value
            If Not IsNull(objRecordset.Fields("mail")) Then
                li.SubItems(2) = objRecordset.Fields("mail").Value
            End If

            objRecordset.MoveNext
        Loop

    End If
End Sub

注意事项

需要注意的是，您需要将 LDAP 字符串更改为您公司的域控制器。例如LDAP://DC=something,DC=co,DC=uk。

如果你不知道这一点，你可以通过以下方式找到它：

Set sysinfo = CreateObject("ADSystemInfo")
MsgBox sysinfo.userName

• 请注意，您只想获取 DC= 部分。
• 所有属性的列表可以在这里找到：http://www.computerperformance.co.uk/Logon/LDAP_attributes_active_directory.htm