Question (Quick and simple I hope)

[KRKComputers]

I was wondering if someone can tell me if Excel has a way to pull a user name from AD using a text box input and an MSGBOX output and if so what the code may be to attempt this?

I have attempted it but each time I try to do so I fail and would greatly appreciate if anyone may know the code for this.

Thanks
Kevin

 

[wideboydixon]

Taken from here: https://www.remkoweijnen.nl/blog/2007/11/01/query-active-directory-from-excel/

Public Sub LookupUser()


Dim cn As String


cn = InputBox("Enter the common name", "AD Lookup")
MsgBox GetAdsProp("cn", cn, "mail"), vbOKOnly + vbInformation, "Email"


End Sub
Public Function GetAdsProp(ByVal SearchField As String, ByVal SearchString As String, ByVal ReturnField As String) As String
    ' Get the domain string ("dc=domain, dc=local")
    Dim strDomain As String
    strDomain = GetObject("LDAP://rootDSE").Get("defaultNamingContext")
    
    ' ADODB Connection to AD
    Dim objConnection As Object
    Set objConnection = CreateObject("ADODB.Connection")
    objConnection.Open "Provider=ADsDSOObject;"
        
    ' Connection
    Dim objCommand As Object
    Set objCommand = CreateObject("ADODB.Command")
    objCommand.ActiveConnection = objConnection
        
    ' Search the AD recursively, starting at root of the domain
    objCommand.CommandText = _
        "<LDAP://" & strDomain & ">;(&(objectCategory=User)" & _
        "(" & SearchField & "=" & SearchString & "));" & SearchField & "," & ReturnField & ";subtree"
 
    ' RecordSet
    Dim objRecordSet As Object
    Set objRecordSet = objCommand.Execute
         
    
    If objRecordSet.RecordCount = 0 Then
        GetAdsProp = "not found"  ' no records returned
    Else
        GetAdsProp = objRecordSet.Fields(ReturnField)  ' return value
    End If
     
    ' Close connection
    objConnection.Close
    
    ' Cleanup
    Set objRecordSet = Nothing
    Set objCommand = Nothing
    Set objConnection = Nothing
End Function

WBD

 

[Logit]

.
Paste into a Routine Module :

Sub UsrName()
    Sheets("Sheet1").Range("F1").Value = Environ("Username")  'change sheet name and cell reference as needed.
End Sub

Guess you are referring to a different system? Disregard my suggestion.

 

[KRKComputers]

Thx wideboy!

The code works great up to this point and then it fails.

" ' RecordSet Dim objRecordSet As Object
Set objRecordSet = objCommand.Execute
"

I enter in the username and get an error at the above area within the code any ideas why this would happen?

Thanks
Kevin

 

[edmitchell]

Hi

there appears to be a bit of text missing in the code, the VBA after the comment "Search the AD recursively, starting at root of the domain", should be :

objCommand.CommandText = _
        "<LDAP://" & strDomain & ">;(&(objectCategory=User)" & _
        "(" & SearchField & "=" & SearchString & "));" & SearchField & "," & ReturnField & ";subtree"

the LDAP & strDomain text are missing if you add this it should then work...

Ed

 

[KRKComputers]

Ed,

Does this go in place of or as an addition to the code that is already in place.

thanks for the help

Kevin

 

[KRKComputers]

Ed,

Sorry just read your message again and misunderstood what you told me. My apologies.

In light of my stupid question when I should have opened my eyes a little more.

Where would I place the information in question and what information am I placing into the area? I do have an idea but want to make sure I place the information into the code in the correct location so I do not make matter worse for myself.

Thanks
Kevin

 

[wideboydixon]

Ah yes. The less than was confusing the post. Change the line to this:

    objCommand.CommandText = _
        "<LDAP://" & strDomain & ">;(&(objectCategory=User)" & _
        "(" & SearchField & "=" & SearchString & "));" & SearchField & "," & ReturnField & ";subtree"

WBD

 

[KRKComputers]

Thx WBD,

I did try that and still get an error in the same location! Any idea why this is happening?

Sorry have not tried this before and am new to this but am trying to find answers when I can.

Your help is appreciated!

Regards
Kevin

 

[wideboydixon]

I'm new to it too! All I can say is that the posted code worked for me. Perhaps it's a permissions issue?

WBD