Question

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

我希望通过使用人名（也可以是firstname + lastname的文本框）将电子邮件地址自动设置到该文本框中，并将其与Active Directory进行比较并检索相应的电子邮件地址。

如何在Word VBA中执行此操作？

Answer 1

尝试一下：它将根据用户名（name1 - 不传递第二个参数）或first（name1）和last（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。

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

2 个答案: