VBA检索与记录的用户名关联的用户的名称

Question

我想在VBA中获取用户的全名(已登录).我在网上找到的这段代码会得到用户名:

UserName = Environ("USERNAME") 

但我想要用户的真实姓名.我发现了一些关于NetUserGetInfo的提示,但不确定该做什么或做什么.任何提示将不胜感激,问候,

Answer 1

除了需要从表单重新编码到模块之外,我还发现API答案很复杂

以下功能来自此专家交流帖的Rob Sampson .这是一个灵活的功能,详见代码注释.请注意它是一个vbscript所以变量没有标注尺寸

Sub Test()
    strUser = InputBox("Please enter a username:")
    struserdn = Get_LDAP_User_Properties("user", "samAccountName", strUser, "displayName")
    If Len(struserdn) <> 0 Then
        MsgBox struserdn
    Else
        MsgBox "No record of " & strUser
    End If
End Sub

Function Get_LDAP_User_Properties(strObjectType, strSearchField, strObjectToGet, strCommaDelimProps)

' This is a custom function that connects to the Active Directory, and returns the specific
' Active Directory attribute value, of a specific Object.
' strObjectType: usually "User" or "Computer"
' strSearchField: the field by which to seach the AD by. This acts like an SQL Query's WHERE clause.
'             It filters the results by the value of strObjectToGet
' strObjectToGet: the value by which the results are filtered by, according the strSearchField.
'             For example, if you are searching based on the user account name, strSearchField
'             would be "samAccountName", and strObjectToGet would be that speicific account name,
'             such as "jsmith".  This equates to "WHERE 'samAccountName' = 'jsmith'"
' strCommaDelimProps: the field from the object to actually return.  For example, if you wanted
'             the home folder path, as defined by the AD, for a specific user, this would be
'             "homeDirectory".  If you want to return the ADsPath so that you can bind to that
'             user and get your own parameters from them, then use "ADsPath" as a return string,
'             then bind to the user: Set objUser = GetObject("LDAP://" & strReturnADsPath)

' Now we're checking if the user account passed may have a domain already specified,
' in which case we connect to that domain in AD, instead of the default one.
    If InStr(strObjectToGet, "\") > 0 Then
        arrGroupBits = Split(strObjectToGet, "\")
        strDC = arrGroupBits(0)
        strDNSDomain = strDC & "/" & "DC=" & Replace(Mid(strDC, InStr(strDC, ".") + 1), ".", ",DC=")
        strObjectToGet = arrGroupBits(1)
    Else
        ' Otherwise we just connect to the default domain
        Set objRootDSE = GetObject("LDAP://RootDSE")
        strDNSDomain = objRootDSE.Get("defaultNamingContext")
    End If

    strBase = "<LDAP://" & strDNSDomain & ">"
    ' Setup ADO objects.
    Set adoCommand = CreateObject("ADODB.Command")
    Set ADOConnection = CreateObject("ADODB.Connection")
    ADOConnection.Provider = "ADsDSOObject"
    ADOConnection.Open "Active Directory Provider"
    adoCommand.ActiveConnection = ADOConnection


    ' Filter on user objects.
    'strFilter = "(&(objectCategory=person)(objectClass=user))"
    strFilter = "(&(objectClass=" & strObjectType & ")(" & strSearchField & "=" & strObjectToGet & "))"

    ' Comma delimited list of attribute values to retrieve.
    strAttributes = strCommaDelimProps
    arrProperties = Split(strCommaDelimProps, ",")

    ' Construct the LDAP syntax query.
    strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
    adoCommand.CommandText = strQuery
    ' Define the maximum records to return
    adoCommand.Properties("Page Size") = 100
    adoCommand.Properties("Timeout") = 30
    adoCommand.Properties("Cache Results") = False

    ' Run the query.
    Set adoRecordset = adoCommand.Execute
    ' Enumerate the resulting recordset.
    strReturnVal = ""
    Do Until adoRecordset.EOF
        ' Retrieve values and display.
        For intCount = LBound(arrProperties) To UBound(arrProperties)
            If strReturnVal = "" Then
                strReturnVal = adoRecordset.Fields(intCount).Value
            Else
                strReturnVal = strReturnVal & vbCrLf & adoRecordset.Fields(intCount).Value
            End If
        Next
        ' Move to the next record in the recordset.
        adoRecordset.MoveNext
    Loop

    ' Clean up.
    adoRecordset.Close
    ADOConnection.Close
    Get_LDAP_User_Properties = strReturnVal

End Function

Answer 2

即使这个线程相当老,其他用户可能仍在谷歌上搜索(像我一样).我找到了一个出色的简短解决方案,对我来说是开箱即用的(感谢Mr.Excel.com).我改变它是因为我需要它返回一个带有用户全名的字符串.原帖是在这里.

编辑:嗯,我修复了一个错误,"结束Sub"而不是"结束函数",并添加了一个变量声明语句,以防万一.我在Excel 2010和2013版本中测试了它.在我的家用电脑上工作得很好(没有域名,只在工作组中).

' This function returns the full name of the currently logged-in user
Function GetUserFullName() as String
    Dim WSHnet, UserName, UserDomain, objUser
    Set WSHnet = CreateObject("WScript.Network")
    UserName = WSHnet.UserName
    UserDomain = WSHnet.UserDomain
    Set objUser = GetObject("WinNT://" & UserDomain & "/" & UserName & ",user")
    GetUserFullName = objUser.FullName
End Function