VBScript to Update Active Directory User Information

I used this script to read in a CSV file of user names, address information, telephone number, and email address. The script is based on the following format for the CSV:

• First name
• Last name
• Address 1
• Address2
• City
• State
• Zip
• Telephone (no spaces, dashes or other characters)
• Email address (in the format user@domain.com)

The script combines the first and last names into a single full name, and parses the telephone into a standard format using parentheses and dashes. Once the script has concatenated the user name, it searches through the current RootDSE to find the OU that the user's account is in. This function returns the full LDAP path for the object which is then used to find the object and make the requested changes. The script outputs to the screen any user name that can't be found or returns any other error. To put this into a log file, I simply use the output modifier ">" and the name of the output file.


OPTION Explicit

On Error Resume Next

Const ADS_PROPERTY_UPDATE = 2

DIM username, ou, n, arrStr
DIM strFullName, strAddress1, strAddress2
DIM strCity, strState, strZIP, strPhone, strEmail
DIM strAreaCode, strExchange, strDID, strTelephone
DIM objUser, objFSO, objCSVFile, objConnection, objCommand
Dim objShell, objFile, objNetwork

Set objShell = CreateObject("WScript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")

'Read CSV
Set objCSVFile = objFSO.OpenTextFile("UserInfo.csv",1)

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

'set counter value
n = 0

Do while NOT objCSVFile.AtEndOfStream

 arrStr = split(objCSVFile.ReadLine,",")

 strFullName = arrstr(n) & " " & arrstr(n+1)
 strAddress1 = arrstr(n+2)
 strAddress2 = arrstr(n+3)
 strCity = arrstr(n+4)
 strState = arrstr(n+5)
 strZip = arrstr(n+6)
 strPhone = arrstr(n+7)
 'build a traditional phone number
 strAreaCode = mid(strPhone,1,3)
 strExchange = mid(strPhone,4,3)
 strDID = mid(strPhone,7,4)
 strTelephone = "(" & strAreaCode & ") " & strExchange & "-" & strDID
 strEmail = arrstr(n+8)

 ' Call function to find OU from computer name
 ou = getOUByUserName(strFullName)

 if ou = "" then
  wscript.echo strFullName
 else
  i = 0
  Set objUser = GetObject("LDAP://cn=" & strFullName & "," & ou & "")

  do while i < 1
   If err.number <> 0 then
    wscript.echo "Error: " & strFullName & " " & err.number
   else
    'Set the attribute values
    objUser.Put "streetAddress", strAddress1 & vbCrLf & strAddress2
    objUser.Put "l", strCity
    objUser.Put "st", strState
    objUser.Put "postalCode", strZip
    objUser.Put "telephoneNumber", strTelephone
    objUser.Put "mail", strEmail
    'Set the user info
    objUser.SetInfo
   end if
  i = i + 1
  loop

 end if

n = 0

Loop
objCSVFile.Close

function getOUByUserName(byval UserName)

 DIM namingContext, ldapFilter, ou
 DIM cn, cmd, rs
 DIM objRootDSE

 set objRootDSE = getobject("LDAP://RootDSE")
 namingContext = objRootDSE.Get("defaultNamingContext")
 set objRootDSE = nothing

 ldapFilter = " ">;(&(objectCategory=User)(name=" & userName & "))" & _
 ";distinguishedName;subtree"

 set cn = createobject("ADODB.Connection")
 set cmd = createobject("ADODB.Command")

 cn.open "Provider=ADsDSOObject;"
 cmd.activeconnection = cn
 cmd.commandtext = ldapFilter

 set rs = cmd.execute

 if rs.eof <> true and rs.bof <> true then
  ou = rs(0)
  ou = mid(ou,instr(ou,",")+1,len(ou)-instr(ou,","))
  getOUByuserName = ou

 end if

 rs.close
 cn.close

end function