Search Valid Users in AD

Const ForReading = 1
Const ForAppending = 8

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objTextFile = objFSO.OpenTextFile("NameList.txt", ForReading)

Do Until objTextFile.AtEndOfStream
strObjectName = objTextFile.Readline
strRootSearch = "DC=Contoso,DC=net"

Set objConnection = CreateObject("ADODB.Connection")
objConnection.Open "Provider=ADsDSOObject;"
Set objCommand = CreateObject("ADODB.Command")
objCommand.ActiveConnection = objConnection

objCommand.CommandText = _
";(&((objectCategory=user)(objectCategory=group))" &_
"(samAccountName=" & strObjectName & "));samAccountName,distinguishedName;subtree"

Set objRecordSet = objCommand.Execute
If objRecordset.RecordCount = 0 Then

intReturnValue=0

Set objFSO1 = CreateObject("Scripting.FileSystemObject")
Set objTextFile1 = objFSO1.OpenTextFile("Output.csv", ForAppending, True)
objTextFile1.WriteLine(strObjectName & vbTab & "Object does not exist")
objTextFile1.Close
Else
objRecordSet.MoveFirst
intReturnValue=1

Set objUser = GetObject ("LDAP://" & objRecordSet.Fields("distinguishedName").Value & "")
arrAttributes = Array("mail")
objUser.GetInfoEx arrAttributes, 0

On Error Resume Next
strDescription = objUser.Get("mail")
If Err.Number <> 0 Then
strDescription = "No Email Address"
Err.Clear
End If

Set objFSO1 = CreateObject("Scripting.FileSystemObject")
Set objTextFile1 = objFSO1.OpenTextFile("Output.csv", ForAppending, True)
objTextFile1.WriteLine(strObjectName & vbTab & "Object exists" & vbTab & strDescription
objTextFile1.Close
End If
objConnection.Close
Loop