Active Directory Bulk Check

[sethu29]

Hello Support,

I'm using the below code to find out the username through Active Directory in Userform

When I enter the EID(Employee ID) in Userform1.Textbox1 and when i hit the search button, then I will get output with Full Display name from Active Directory in Userform1.textbox2

Now if I've large data in A column, Is it possible to check all at once and mention the remarks as " User name found/Username or User Not Found"

I'm attaching the Workbook and below is the code


_______________________________________________________
Sub test()


strInput = Userform1.TextBox1.Value




If UserExists(strInput, sDisName) Then
Userform1.TextBox2.Value = sDisName
Else
MsgBox "No account found for " & strInput
End If


End Sub



Function UserExists(sUser, sDisName)
Dim oConn, oCMD, oRoot, sDNSDomain, sQuery, sFilter, oResults
UserExists = False
sDisName = sUser
On Error Resume Next


' Use ADO to search the domain for all users.
Set oConn = CreateObject("ADODB.Connection")
Set oCMD = CreateObject("ADODB.Command")
oConn.Provider = "ADsDSOOBject"
oConn.Open "Active Directory Provider"
Set oCMD.ActiveConnection = oConn


' Determine the DNS domain from the RootDSE object.
Set oRoot = GetObject("LDAP://RootDSE")
sDNSDomain = oRoot.Get("DefaultNamingContext")
sFilter = "(&(ObjectClass=user)(ObjectCategory=person)(samAccountName=" & sUser & "))"
sQuery = "<LDAP://" & sDNSDomain & ">;" & sFilter & ";displayName;subtree"
oCMD.CommandText = sQuery
oCMD.Properties("Page Size") = 100
oCMD.Properties("Timeout") = 30
oCMD.Properties("Cache Results") = False
Set oResults = oCMD.Execute


Do Until oResults.EOF
If oResults.Fields("displayName") <> "" Then
sDisName = oResults.Fields("displayName")
UserExists = True
End If
oResults.MoveNext
Loop
On Error GoTo 0
End Function

[大灰狼1976]

Hi sethu29!

Sub test()
Dim arr, i&
arr = Sheets(1).Range("a2:a" & Sheets(1).[a65536].End(3).Row).Resize(, 2)
For i = 1 To UBound(arr)
  strInput = arr(i, 1)
  If UserExists(strInput, sDisName) Then
    arr(i, 2) = "User name found"
  Else
    arr(i, 2) = "Username or User Not Found"
  End If
Next i
Sheets(1).[b2].Resize(UBound(arr)) = Application.Index(arr, , 2)
End Sub

[sethu29]

Wow. Thank you so Much.. This works perfectly