Script to update Active Directory Database from Excel file

Script to update Active Directory Database from Excel file

Flow Chart :- 

Excel file before Update:-

Excel file after Update:-

Script :- 

'Script to update Active Directory Database from Excel file

Option Explicit
Dim strExcelPath,ObjExcel,objSheet,intRow,strUserFirstName,strUserLastName
Dim strUserTitle,strManagerFirstName,strManagerLastName
Dim adocommand, adoconnection, strBase, strFilter, strAttributes
Dim objRootDSE, strDNSDomain, strQuery, adoRecordset, strName, strCN , strGivenNAme ,strSN, strmail, strADsPath
Dim objUser,varTotalUsers,strFilter2,strQuery2,strManager,i,strValue

' Specify File.

strExcelPath = "c:\test.xls"

'Open File
Set ObjExcel = CreateObject("Excel.Application")

On Error Resume Next
objExcel.Application.Visible = True
objExcel.Workbooks.Open strExcelPath
If Err.Number <> 0 Then
  On Error GoTo 0
  Wscript.Echo "Unable to open spreadsheet " & strExcelPath
  Wscript.Quit
End If
On Error GoTo 0

Set objSheet = objExcel.ActiveWorkbook.Worksheets(1)

' Start with row 2 of spreadsheet.
' Assume first row has column headings.

intRow = 2

' Read each row of spreadsheet until a blank value

Do Until objExcel.Cells(intRow,1).Value = ""

  ' Read values from spreadsheet for this user.
 
  strUserFirstName = Trim(objSheet.Cells(intRow, 1).Value)
  strUserLastName = Trim(objSheet.Cells(intRow, 2).Value)
  strUserTitle = Trim(objSheet.Cells(intRow, 3).Value)
  strManagerFirstName = Trim(objSheet.Cells(intRow, 4).Value)
  strManagerLastName = Trim(objSheet.Cells(intRow, 5).Value)
  On Error Resume Next
 
'Setup ADO Objects.
Set adocommand = CreateObject("ADODB.Command")
Set adoConnection = CreateObject("ADODB.Connection")
adoConnection.Provider = "ADsDSOobject"
adoConnection.Open "Active Directory Provider"
Set adoCommand.ActiveConnection = adoConnection

' Search entire Active Directory Domain
Set objRootDSE = GetObject("LDAP://RootDSE")

strDNSDomain = objRootDSE.Get("defaultNamingContext")
strBase = "<LDAP://" & strDNSDomain & ">" 
 
' Filter on user objects.

strFilter2 = "(&(objectCategory=person)(objectClass=user)(givenName=" & strManagerFirstName &")(sn=" & strManagerLastName&"))"
'Comma delimited list of attribute values to retrieve.
strAttributes = "sAMAccountName,cn,givenName,sn,mail,ADsPath"
'Constuct the LDAP syntax query
strQuery2 = strBase & ";" & strFilter2 & ";" & strAttributes & ";subtree"
adocommand.commandText = strQuery2
adoCommand.Properties("Page Size") = 100
adoCommand.Properties("TimeOut") = 30
adoCommand.properties("Cache Results") = False
' Run the query
Set adoRecordset = adoCommand.Execute
' Enumerate the resulting recordset.
 If adoRecordset.Fields("sAMAccountName").Value = "" Then
     Wscript.Echo "Manager Record not found for user " & strUserFirstName & " " & strUserLastName
     ObjExcel.Cells(intRow,4).Font.Bold = TRUE
     ObjExcel.Cells(intRow,5).Font.Bold = TRUE
     ObjExcel.Cells(intRow,4).Font.Color = vbRed
     ObjExcel.Cells(intRow,5).Font.Color = vbRed
 else
 Do Until adoRecordset.EOF
   
   ' Retrieve values and display.
   varTotalUsers =adoRecordset.RecordCount
   'Wscript.Echo varTotalUsers
   If varTotalUsers = 1 Then
   strADsPath = adoRecordset.Fields("AdsPath").Value
   strValue = Split(strADsPath,"://")
   For i = 0 to Ubound(strValue)
    strManager=strValue(1)
   Next
   WScript.Echo strManager
   'Wscript.Echo "Display Name: " & strCN & ", ADsPath:" & strADsPath
   WScript.Echo "manager " & strCN & " found"
   ElseIf varTotalUsers > 1 Then
   ObjExcel.Cells(intRow,4).Font.Bold = TRUE
   ObjExcel.Cells(intRow,5).Font.Bold = TRUE
  
   End If
  'Move to the Next Record in the recordset.
  adoRecordSet.MoveNext
  Loop
  End IF

'Wscript.Echo strManagerFirstName & " " & strManagerLastName & " is manager of " & strUserFirstName & " " & strUserLastName


strFilter = "(&(objectCategory=person)(objectClass=user)(givenName=" & strUserFirstName &")(sn=" & strUserLastName&"))"
'Constuct the LDAP syntax query
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"

adocommand.commandText = strQuery
adoCommand.Properties("Page Size") = 100
adoCommand.Properties("TimeOut") = 30
adoCommand.properties("Cache Results") = False

' Run the query
Set adoRecordset = adoCommand.Execute

 ' Enumerate the resulting recordset.
 If adoRecordset.Fields("sAMAccountName").Value = "" Then
     Wscript.Echo "User Record not found"
     ObjExcel.Cells(intRow,1).Font.Bold = TRUE
     ObjExcel.Cells(intRow,2).Font.Bold = TRUE
     ObjExcel.Cells(intRow,1).Font.Color = vbRed
     ObjExcel.Cells(intRow,2).Font.Color = vbRed
 else
Do Until adoRecordset.EOF
   ' Retrieve values and display.
   varTotalUsers =adoRecordset.RecordCount
   'Wscript.Echo varTotalUsers
   If varTotalUsers = 1 Then
   strADsPath = adoRecordset.Fields("AdsPath").Value
   set objUser = GetObject(strADsPath)
   objUser.Put "manager", strManager
   objUser.Put "description",strUserTitle
   objUser.Put "title", strUserTitle
   objUser.Put "company", "Glam Media"
   objUser.SetInfo
   'Wscript.Echo "Display Name: " & strCN & ", ADsPath:" & strADsPath
   WScript.Echo "User " & strCN & " found"
   ElseIf varTotalUsers > 1 Then
   ObjExcel.Cells(intRow,1).Font.Bold = TRUE
   ObjExcel.Cells(intRow,2).Font.Bold = TRUE
   End If
  'Move to the Next Record in the recordset.
  adoRecordSet.MoveNext
  Loop
  End IF

' Wscript.Echo "First Name: " &  strUserFirstName & "Last Name: " & strUserLastName

       
intRow = intRow + 1

Loop
objExcel.ActiveWorkbook.Saveas "C:\updated_File.xls"
objExcel.Quit
ObjWcript.Quit