Excel: Get Department from Active Directory


Function GetDepartment(strAccountName As String, strDomainName As String)
Dim adoLDAPCon As ADODB.Connection
Dim adoLDAPRS As Recordset
Dim strLDAP As String

If strAccountName = "" Or strAccountName = "-" Then
GetDepartment = "invalid input"
Exit Function
End If

Set adoLDAPCon = CreateObject("ADODB.Connection")
adoLDAPCon.Provider = "ADsDSOObject"
adoLDAPCon.Open "ADSI"
strLDAP = "'LDAP://" & strDomainName & "'"

Set adoLDAPRS = adoLDAPCon.Execute("select department from " & strLDAP & " WHERE objectClass = 'user'" & " And samAccountName = '" & strAccountName & "'")
With adoLDAPRS
If Not .EOF Then
GetDepartment = .Fields("department")
Else
GetDepartment = "not found"
End If

End With
adoLDAPRS.Close
Set adoLDAPRS = Nothing
Set adoLDAPCon = Nothing

End Function