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

Question

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

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

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

  

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

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

软件：这必须在OFffice 2010套件中运行。我不需要任何后备兼容性，并且未来的打样是目前最小的问题。

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

任何提示都将不胜感激。

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

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

您可以创建自己的UserForm以从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