Query Active Directory from Excel

This is and old post from Remko Weijnen with some comde to get information from Active Directory.

I had to lookup some users in Active Directory today which I received by mail. Offcourse I got full users name while I needed either samAccountName or full adsPath. Usually I write a small VBS script to do the lookup and paste this in Excel for further processing. But today I decided that an Excel function to do the lookup would be nice. So I wrote it.

The function is called GetAdsProp and allows you to search on a specific AD field in the whole AD tree and return the value of another field.

So how does it work? In this example I have full name in Cell A2, in B2 I want to lookup the Accountname and in C2 the E-Mail address.

In Cell B2 use the formula: =GetAdsprop("cn"; A2; "samAccountName")

In Cell B3 use the formula: =GetAdsprop("cn"; A2; "mail")

This is the code:

Visual Basic

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 ADODB.Connection

Set objConnection = CreateObject("ADODB.Connection")

objConnection.Open "Provider=ADsDSOObject;"

' Connection

Dim objCommand As ADODB.Command

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 ADODB.Recordset

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

That’s nice, but want if we want to perform some action on the looked up results? In my case I needed to move the users to another OU. So I made a function for that too. It’s called MoveADObject.

Function MoveADObject(ByVal strObjectCN, ByVal strDestinationOU)

Dim objDestination As IADsContainer

Set objDestination = GetObject("LDAP://" & strDestinationOU)

' Let the user confirm the move

If MsgBox("Move " & strObjectCN & vbCrLf & "to " & objDestination.AdsPath, vbQuestion + vbYesNo) = vbYes Then

' Move the object!

Dim objMoved As IADs

Set objMoved = objDestination.MoveHere(strObjectCN, vbNullString)

' Set the new AdsPath as the function result

MoveADObject = objMoved.AdsPath

End If

'Cleanup

Set objMoved = Nothing

Set objDestination = Nothing

End Function

To move an object (eg a user) in Active Directory you need it’s full path which is something like ("CN=User,OU=MyOU,DC=MyDomain,DC=local" Every object in Active Directory has this stored in a propery adsPath. So we use the GetAdsProp function to do a lookup. Put this formula in Cell B4: =GetAdsProp("cn";A2;"AdsPath")

 

Now use the following formula in Cell D2: =MoveADObject(C2;"OU=Admin Users,OU=Users,OU=Netherlands,DC=europe,dc=unity")

The function asks for your confirmation first:

And the the object is moved. After the moving the value of the Cell will be the new adsPath.

I added both functions to an Excel XLA Addin which you can add in your Addins directory, then it will be available in all you Excel sheets. (The Addins directory is usually in %userprofile%\AppData\Roaming\Microsoft\Addins )

RWADAddin.zip (19859 downloads)

Also, you may need to add a reference to "Microsoft ActiveX Data Objects 2.5 Library": This reference is required for early binding.

Tools > References > Check the checkbox in front of "Microsoft ActiveX Data Objects 2.5 Library"