VBA Recupera el nombre del usuario asociado con el nombre de usuario registrado

Solución:

Incluso si este hilo es bastante antiguo, es posible que otros usuarios todavía estén buscando en Google (como yo). Encontré una excelente solución corta que funcionó para mí de inmediato (gracias a Mr.Excel.com). Lo cambié porque lo necesitaba para devolver una cadena con el nombre completo del usuario. El post original está aquí.

EDITAR: Bueno, arreglé un error, “End Sub” en lugar de “End Function” y agregué una declaración de declaración de variable, por si acaso. Lo probé en las versiones de Excel 2010 y 2013. También funcionó bien en mi PC de casa (sin dominio, solo en un grupo de trabajo).

' 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 & "https://foroayuda.es/" & UserName & ",user")
    GetUserFullName = objUser.FullName
End Function

También encontré la respuesta de la API compleja, además de necesitar recodificar de un formulario a un módulo

La función a continuación es cortesía de Rob Sampson de esta publicación de Experts-Exchange. Es una función flexible, consulte los comentarios del código para obtener más detalles. Tenga en cuenta que era un vbscript, por lo que las variables no están dimensionadas

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 & "https://foroayuda.es/" & "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 = "(&(object)(" & 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

---

---

Utiliza Nuestro Buscador