Question (Quick and simple I hope)

KRKComputers

New Member
Joined
Nov 10, 2017
Messages
43
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
 

Excel Facts

Best way to learn Power Query?
Read M is for (Data) Monkey book by Ken Puls and Miguel Escobar. It is the complete guide to Power Query.
Taken from here: https://www.remkoweijnen.nl/blog/2007/11/01/query-active-directory-from-excel/

Code:
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
 
Upvote 0
.
Paste into a Routine Module :

Code:
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.
 
Last edited:
Upvote 0
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
 
Last edited by a moderator:
Upvote 0
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 :

Code:
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
 
Upvote 0
Ed,

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

thanks for the help

Kevin
 
Last edited by a moderator:
Upvote 0
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
 
Last edited by a moderator:
Upvote 0
Ah yes. The less than was confusing the post. Change the line to this:

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

WBD
 
Upvote 0
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
 
Upvote 0

Forum statistics

Threads
1,223,897
Messages
6,175,270
Members
452,628
Latest member
dd2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top