使用Word中的VBA从Active Directory获取电子邮件地址

Question

我有Word VBA代码，该代码通过邮件发送文档。收件人电子邮件地址被手动写入文本框中，然后自动提交到Outlook。

我希望通过使用人名（也就是名字和姓氏的文本框）将电子邮件地址自动设置到该文本框中，将其与Active Directory进行比较并检索适当的电子邮件地址。

如何在Word VBA中做到这一点？

Answer 1

尝试一下：它将根据用户名（名称1-不传递第二个参数）或名字（name1）和姓氏（name2）来查询电子邮件。

Function UserNameToEmail(name1 As String, Optional name2 As String = "")

    Set rootDSE = GetObject("LDAP://RootDSE")
    base = "<LDAP://" & rootDSE.Get("defaultNamingContext") & ">"

    'filter on user objects with the given account name
    fltr = "(&(objectClass=user)(objectCategory=Person)"
    If Len(name2) = 0 Then
        fltr = fltr & "(sAMAccountName=" & name1 & "))"
    Else
        fltr = fltr & "(givenName=" & name1 & ")(sn=" & name2 & "))"
    End If

    'add other attributes according to your requirements
    attr = "mail,department,givenName,sn"
    scope = "subtree"

    Set conn = CreateObject("ADODB.Connection")
    conn.Provider = "ADsDSOObject"
    conn.Open "Active Directory Provider"

    Set cmd = CreateObject("ADODB.Command")
    Set cmd.ActiveConnection = conn
    cmd.CommandText = base & ";" & fltr & ";" & attr & ";" & scope

    Set rs = cmd.Execute

    If Not rs.EOF Then
      For Each f In rs.Fields
        Debug.Print f.Name & ": " & f.Value
      Next f
      UserNameToEmail = rs.Fields("mail").Value
    End If

    rs.Close
    conn.Close

End Function

FYI- ActiveDirectory字段列表：http://www.kouti.com/tables/userattributes.htm

Answer 2

您是否正在使用Outlook对象模型？ Callin Recipient.Resolve或Recipeints.ResolveAll将解析邮件收件人的显示名称。

如果要在不创建消息的情况下将名称解析为地址，请使用Namespace.CreateRecipient / Recipeint.Resolve。

Answer 3

感谢出色的代码。仍然有一个问题：如何管理用户ID？

。To = UserNameToEmail（userID）

userID被定义为字符串，并且值是另一个表中的vlookup before。使用您提供的代码，它只将字符串作为可接受的值。

感谢您的预先支持。

亚历