VBA get windows first and last name of user

Question

I am using the following code to get the first and last name of a windows user.

The username is in cell A2 like:

SmithD

The code works but it puts the user's last name seperated by a comma and then their first name. I.e:

Smith, Dave

I want to change this to look like:

Dave.Smith and then add @inbox.com

So:

Dave.Smith@inbox.com

Sub Test()
    strUser = Range("A2").Value
    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

Please can someone show me where i am going wrong?

Answer 1

Please can someone show me where i am going wrong?

You're asking for the displayName, and that's what you're getting ("Doe, John"). What you want is not the "display name", but the user's first and last name.

Let's look at the signature for the function you've got here:

Function Get_LDAP_User_Properties(strObjectType, strSearchField, strObjectToGet, strCommaDelimProps)

That last parameter is named strCommaDelimProps, short for "string, comma-delimited property names".

If you look at what it's doing with the strCommaDelimProps you're giving it, you'll notice it's concatenated into the strQuery that's sent to the LDAP server, and then it's also turned into an array named arrProperties (gosh dat Hungarian naming):

arrProperties = Split(strCommaDelimProps, ",")

Then it loops through the query results and...

strReturnVal = strReturnVal & vbCrLf & adoRecordset.Fields(intCount).Value

That's right, it appends each field value to the strReturnVal string, with each result separated by a vbCrLf.

So if you were to give the function two properties separated by commas, it would return you a string with the two values, separated by vbCrLf characters. That would look something like this:

"John[CRLF]
Doe"

So you take that string, Split it on vbCrLf to make an array, and Join it using a dot delimiter (.):

strParts = Get_LDAP_User_Properties("user", "samAccountName", strUser, "givenName,sn")
arrParts = Split(strParts, vbCrLf) 'splits the string into an array
result = Join(arrParts, ".") 'joins array elements back into a string

The two properties are, per cyboashu's answer, "givenName" and "sn", so you give the function "givenName,sn" for the last parameter.

At that point the result string looks something like John.Doe; you might want to make that lowercase before you concatenate the @inbox.com part:

result = LCase$(result) & "@inbox.com"
MsgBox result

---

As for what am I doing wrong?, the latest Rubberduck (my little pet project) can help you pinpoint a few things:

Warning: 'Vbnullstring' preferred to empty string literals - (Book2) VBAProject.Module1, line 69
Warning: 'Vbnullstring' preferred to empty string literals - (Book2) VBAProject.Module1, line 73
Warning: Parameter 'strObjectType' is implicitly Variant - (Book2) VBAProject.Module1, line 11
Warning: Parameter 'strSearchField' is implicitly Variant - (Book2) VBAProject.Module1, line 11
Warning: Parameter 'strObjectToGet' is implicitly Variant - (Book2) VBAProject.Module1, line 11
Warning: Parameter 'strCommaDelimProps' is implicitly Variant - (Book2) VBAProject.Module1, line 11
Warning: Member 'Range' implicitly references ActiveSheet - (Book2) VBAProject.Module1, line 2
Hint: Member 'Test' is implicitly public - (Book2) VBAProject.Module1, line 1
Hint: Member 'Get_LDAP_User_Properties' is implicitly public - (Book2) VBAProject.Module1, line 11
Hint: Parameter 'strObjectType' is implicitly passed by reference - (Book2) VBAProject.Module1, line 11
Hint: Parameter 'strSearchField' is implicitly passed by reference - (Book2) VBAProject.Module1, line 11
Hint: Parameter 'strObjectToGet' is implicitly passed by reference - (Book2) VBAProject.Module1, line 11
Hint: Parameter 'strCommaDelimProps' is implicitly passed by reference - (Book2) VBAProject.Module1, line 11
Hint: Return type of member 'Get_LDAP_User_Properties' is implicitly 'Variant' - (Book2) VBAProject.Module1, line 11
Error: Option Explicit is not specified in 'Module1' - (Book2) VBAProject.Module1, line 1
Error: Local variable 'strUser' is not declared - (Book2) VBAProject.Module1, line 2
Error: Local variable 'struserdn' is not declared - (Book2) VBAProject.Module1, line 3

Answer 2

You can do it in two ways. 1. Split the displayName on "," and re-arrange.

 struserdn = Get_LDAP_User_Properties("user", "samAccountName", strUser, "displayName")
    struserdn = Split(struserdn, ",")(1) & Space(1) & Split(struserdn, ",")(0)

2.You can get First Name and Last Name in seperate calls using GivenName and sn params.

strFirstName = Get_LDAP_User_Properties("user", "samAccountName", strUser, "givenName") strLastName = Get_LDAP_User_Properties("user", "samAccountName", strUser, "sn")

But thi smethod will make twice the use of resources.

Edit :

As per Matt's comment.

Change this line

strReturnVal = strReturnVal & vbcrlf & adoRecordset.Fields(intCount).Value

To

strReturnVal = strReturnVal & "." & adoRecordset.Fields(intCount).Value

and then this will give you the full name in just one call.

 strFullName = Get_LDAP_User_Properties("user", "samAccountName", strUser, "givenName,sn")

Answer 3

I used this code to get the username of the user.

Option Explicit
Public strUser As String
Private Sub Workbook_Open()
Dim strUser

    strUser = CreateObject("WScript.Network").UserName

End Sub