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
