'Script by  Felipe Ferreira
'Based on Script by TomRiddle 2008
'Date: 05/06/08
'Version: 1.0
'ActiveDirectory - Find UserName(s) from supplied EmailAddress(s)
'Enter one email address when prompted or place a populated carriage return separated txt file with email addresses in same directory as script. 

 option explicit
 Dim infile, EmailAddress, answer, objFSO, objTextFileInput, strNextLine, arrList, i, outfile
 infile="emails.txt"    'The name of your input text file. Read above for specs of file.
 outfile="users_emails_" & cstr(day(now())) &"_" & cstr(Month(now()))&".txt"
 
 Dim Fso : Set Fso = CreateObject("Scripting.FileSystemObject")
 Dim oFile : Set oFile = Fso.CreateTextFile(outfile, TRUE)  'modified FELIPE
 oFile.Writeline "EMAIL ; USERNAME"
 EmailAddress=inputbox("Enter Single Email Address", "Script by TomRiddle") 
 If EmailAddress <>"" then
    SearchOnEmailAddress EmailAddress
 else
    answer=MsgBox("Are You sure you want try and to read from "&infile&" file?",52,"Script by TomRiddle")
    if answer=7 then wscript.quit
	    Const ForReading = 1
	    Set objFSO = CreateObject("Scripting.FileSystemObject")
		if objFSO.FileExists(infile) then                              'modified FELIPE
	    Set objTextFileInput = objFSO.OpenTextFile (infile, ForReading)
	    Do until objTextFileInput.AtEndOfStream
	       strNextLine = objTextFileInput.Readline
	       arrList = Split(strNextLine , vbcrlf)  
	       For i = 0 to Ubound(arrList)
	          SearchOnEmailAddress arrList(i)
	       Next
	    Loop
	    objTextFileInput.Close
	else 
		wscript.echo "Error: Input File " & infile & " not found!"     'modified FELIPE
	end if
 end if
 wscript.echo "Done, check output file: " & outfile
 wscript.quit
'---------------------------------------
Sub SearchOnEmailAddress(Emailaddress)
 on error resume next
 Dim objConnection, objCommand, objRootDSE, strDNSDomain
 Dim strFilter, strQuery, objRecordSet, strBase, strAttributes, strDN, UserName
 
 
 Set objConnection = CreateObject("ADODB.Connection")
 Set objCommand = CreateObject("ADODB.Command")
 objConnection.Provider = "ADsDSOOBject"
 objConnection.Open "Active Directory Provider"
 Set objCommand.ActiveConnection = objConnection
  Set objRootDSE = GetObject("LDAP://RootDSE")
 strDNSDomain = objRootDSE.Get("defaultNamingContext")
 strBase = "<LDAP://" & strDNSDomain & ">"
 strFilter = "(&(&(|(&(objectCategory=person)(objectSid=*)(!samAccountType:1.2.840.113556.1.4.804:=3))(&(objectCategory=person)(!objectSid=*))(&(objectCategory=group)(groupType:1.2.840.113556.1.4.804:=14)))(objectCategory=user)(mail=" & EmailAddress & ")))"
 strAttributes = "distinguishedName"
 strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
 objCommand.CommandText = strQuery
 objCommand.Properties("Page Size") = 99999
 objCommand.Properties("Timeout") = 300
 objCommand.Properties("Cache Results") = False
 Set objRecordSet = objCommand.Execute
 objRecordSet.MoveFirst
 if err<>0 then wscript.echo "Not Found"
 Do Until objRecordSet.EOF        
    strDN = objRecordSet.Fields("distinguishedName")
    'wscript.echo myUserName(strDN)
	oFile.WriteLine Emailaddress & "  ;  " & myUserName(strDN) 'modified FELIPE
    objRecordSet.MoveNext
 Loop
 objConnection.Close
 Set objConnection = Nothing  
 Set objCommand = Nothing
 Set objRootDSE = Nothing
 Set objRecordSet = Nothing
 on error goto 0
end Sub
'---------------------------------------
function myUserName(DN)
 dim ObjUser
 Set objUser = GetObject ("LDAP://"&DN)
 myUserName=objUser.sAMAccountName
'myUserName=objUser.userPrincipalName      (Could try this one instead)
end function
'---------------------------------------