vba - 如何根据Windows登录名使用VBA获取电子邮件地址？

Question

如何使用 VBA 根据 Windows 用户名获取网络上用户的电子邮件地址？

我有一个日志文件，其中包含启动此 Access 数据库的每个人的用户名。用户名是在启动数据库时从 Environ("USERNAME") 生成的。我需要向所有最近的用户发送一封电子邮件。

我不需要它来返回当前用户的电子邮件地址，也不需要代码来发送电子邮件。

我想知道是否可以使用 LDAP，但我的示例仅适用于当前登录的用户。还有别的办法吗？

Function GetEmailAddress(Optional strUserName As String = "") As String
' Get user's email address from LDAP

    Dim sysInfo         As Object
    Dim oUser           As Object

    If strUserName = "" Then
        ' No name was passed in.  Get it for the current user.
        strUserName = Environ("USERNAME")
    End If

    ' How I can I use strUserName to get the email address?
    ' The LDAP query below only works for the current logged in user.

    Set sysInfo = CreateObject("ADSystemInfo")
    Set oUser = GetObject("LDAP://" & sysInfo.UserName & "")

    Debug.Print "Display Name: "; Tab(20); oUser.Get("DisplayName")
    Debug.Print "Email Address: "; Tab(20); oUser.Get("mail")
    Debug.Print "Computer Name: "; Tab(20); sysInfo.ComputerName
    Debug.Print "Site Name: "; Tab(20); sysInfo.SiteName
    Debug.Print "Domain DNS Name: "; Tab(20); sysInfo.DomainDNSName

    GetEmailAddress = oUser.Get("mail")

    Set sysInfo = Nothing
    Set oUser = Nothing
End Function

Answer 1

就我个人而言，我使用以下函数，尽管有很多可能性。

Public Function GetMailAddress(strUsername As String) As String
    Dim cmd As New ADODB.Command
    Dim cn As New ADODB.Connection
    Dim rs As ADODB.Recordset
    cn.Open "Provider=ADsDSOObject;"
    cmd.CommandText = "<LDAP://dc=MyCompany,dc=intranet>;(&(objectCategory=User)(CN=" & strUsername & "));mail;subtree"
    cmd.ActiveConnection = cn
    Set rs = cmd.Execute
    GetMailAddress = rs.Fields(0).Value
End Function

当然，您需要填写 LDAP 服务器的有效 DC 值。