asked on

AD User Creation from Excel Sheet

I have creted the below script for AD ID creation from excel sheet and Want to name the login id from six characters of firstname and adding one char from first name like testusn and if the lastname doesn't have six char, it should be like testl. If the login id was already created in AD , then it should be like testl1, testl2. The script should read all the excel file in the particular folder path like C:\IDCreation and do the user creation. If all ID's are created without any error, excel sheet should be moved to the folder path like C:\CompletedID.

Option Explicit
Dim objRootLDAP, objContainer, objUser, objShell,objFso
Dim objExcel, objSpread, intRow
Dim strUser, strOU, strSheet
Dim strCN, strSam, strFirst, strLast, strPWD, Strname, objGroup1,objGroup2,StrHOhome,StrUsrHome,intRunError

StrHOhome = "\\inhosvr01\home\"
strSheet = "c:\New_users.xls"

Set objFso = CreateObject("Scripting.FileSystemObject")
Set objShell = CreateObject("Wscript.Shell")

' Open the Excel spreadsheet
Set objExcel = CreateObject("Excel.Application")
Set objSpread = objExcel.Workbooks.Open(strSheet)
intRow = 2

Do Until objExcel.Cells(intRow,2).Value = ""
strSam = Trim(objExcel.Cells(intRow, 1).Value)
strCN = Trim(objExcel.Cells(intRow, 2).Value)
strFirst = Trim(objExcel.Cells(intRow, 3).Value)
strLast = Trim(objExcel.Cells(intRow, 4).Value)
strPWD = Trim(objExcel.Cells(intRow, 5).Value)
Strname = Trim(objExcel.Cells(intRow, 6).Value)
If Strname = "ho" Then
strOU = "OU=Users,OU=CORP,"
ElseIf Strname ="datacentre" Then
strou = "OU=Users,OU=MDC,OU=Data Centre,"
Else
Wscript.quit
End IF

' Bind to Active Directory, Users container.
Set objRootLDAP = GetObject("LDAP://rootDSE")
Set objContainer = GetObject("LDAP://" & strOU & _
objRootLDAP.Get("defaultNamingContext"))

' Build the actual User from data in strSheet.
Set objUser = objContainer.Create("User", "cn=" & strCN)
objUser.sAMAccountName = strSam
objUser.givenName = strFirst
objUser.sn = strLast
objUser.SetInfo

objUser.userAccountControl = 512
objUser.pwdLastSet = 0
objUser.SetPassword strPWD
objUser.SetInfo
Call addgrp

intRow = intRow+1
Loop

objExcel.Quit

Sub addgrp
If Strname = "ho" Then
Set objGroup1 = GetObject("LDAP://CN=common_Full(HO),CN=Users,DC=test,DC=com")
Set objGroup2 = GetObject("LDAP://CN=Public_Read_HO,OU=G-File Server Groups,DC=test,DC=com")
objGroup1.Add(objUser.ADsPath)
objGroup2.Add(objUser.ADsPath)
objUser.SetInfo
StrUsrHome = StrHOhome & Strsam
ObjFso.CreateFolder StrUsrHome
If objFSO.FolderExists(StrUsrHome) Then
objShell.Run "%COMSPEC% /c Echo Y| cacls " & StrUsrHome & " /C /G test\" & Strsam & ":F"
End IF
End If
End Sub

id-creation.JPG

RobSampson

Hi, I haven't done any of the folder enumeration for XLS files, or moving of the XLS file, but test this on a single XLS file first, and see if it works as required.

Regards,

Rob.

'Option Explicit
Dim objRootLDAP, objContainer, objUser, objShell,objFso
Dim objExcel, objSpread, intRow
Dim strUser, strOU, strSheet
Dim strCN, strSam, strFirst, strLast, strPWD, Strname, objGroup1,objGroup2,StrHOhome,StrUsrHome,intRunError

StrHOhome = "\\inhosvr01\home\"
strSheet = "c:\New_users.xls"

Set objFso = CreateObject("Scripting.FileSystemObject")
Set objShell = CreateObject("Wscript.Shell") 


' Open the Excel spreadsheet
Set objExcel = CreateObject("Excel.Application")
Set objSpread = objExcel.Workbooks.Open(strSheet)
intRow = 2


Do Until objExcel.Cells(intRow,2).Value = ""
	'strSam = Trim(objExcel.Cells(intRow, 1).Value)
	strCN = Trim(objExcel.Cells(intRow, 2).Value) 
	strFirst = Trim(objExcel.Cells(intRow, 3).Value)
	strLast = Trim(objExcel.Cells(intRow, 4).Value)
	strPWD = Trim(objExcel.Cells(intRow, 5).Value)
	Strname = Trim(objExcel.Cells(intRow, 6).Value)
	If Len(strLast) > 6 Then
		strSam = Left(strLast, 6) & Left(strFirst, 1)
	Else
		strSam = strLast & Left(strFirst, 1)
	End If
	If Strname = "ho" Then
		strOU = "OU=Users,OU=CORP," 
	ElseIf Strname ="datacentre" Then
		strou = "OU=Users,OU=MDC,OU=Data Centre,"
	Else
		Wscript.quit
	End If

	' Bind to Active Directory, Users container.
	Set objRootLDAP = GetObject("LDAP://rootDSE")
	Set objContainer = GetObject("LDAP://" & strOU & objRootLDAP.Get("defaultNamingContext")) 

	' Check if the user already exists
	strDNCheck = ""
	strDNCheck = Get_LDAP_User_Properties("user", "distinguishedName", "cn=" & strCN & "," & objContainer.distinguishedName, "adsPath")
	If InStr(strDNCheck, "LDAP://") > 0 Then
		WScript.Echo "User already exists: " & "cn=" & strCN & "," & objContainer.distinguishedName
	Else
		strLoginCheck = ""
		intNum = 0
		strOrigSam = strSam
		strLoginCheck = Get_LDAP_User_Properties("user", "samAccountName", strSam, "adsPath")
		While InStr(strLoginCheck, "LDAP://") > 0
			WScript.Echo "Login name already exists: " & strSam & vbCrLf & "for " & strLoginCheck
			intNum = intNum + 1
			strSam = strOrigSam & intNum
			strLoginCheck = Get_LDAP_User_Properties("user", "samAccountName", strSam, "adsPath")
		Wend
		' Build the actual User from data in strSheet.
		WScript.Echo "Creating " & strCN & " with login name " & strSam
		Set objUser = objContainer.Create("User", "cn=" & strCN)
		objUser.sAMAccountName = strSam
		objUser.givenName = strFirst
		objUser.sn = strLast
		objUser.SetInfo
		
		objUser.userAccountControl = 512
		objUser.pwdLastSet = 0
		objUser.SetPassword strPWD
		objUser.SetInfo
		
		' Update the spreadsheet to reflect the samAccountName change, if any
		objExcel.Cells(intRow, 1).Value = strSam
		
		Call addgrp
	End If
	intRow = intRow+1
Loop

objExcel.Quit 

Sub addgrp
	If Strname = "ho" Then
		Set objGroup1 = GetObject("LDAP://CN=common_Full(HO),CN=Users,DC=test,DC=com")
		Set objGroup2 = GetObject("LDAP://CN=Public_Read_HO,OU=G-File Server Groups,DC=test,DC=com")
		objGroup1.Add(objUser.ADsPath)
		objGroup2.Add(objUser.ADsPath)
		objUser.SetInfo
		StrUsrHome = StrHOhome & Strsam
		ObjFso.CreateFolder StrUsrHome
		If objFSO.FolderExists(StrUsrHome) Then
			objShell.Run "%COMSPEC% /c Echo Y| cacls  " & StrUsrHome & " /C /G test\" & Strsam & ":F"
		End If
	End If
End Sub

Function Get_LDAP_User_Properties(strObjectType, strSearchField, strObjectToGet, strCommaDelimProps)
      
      If InStr(strObjectToGet, "\") > 0 Then
            arrGroupBits = Split(strObjectToGet, "\")
            strDC = arrGroupBits(0)
            strDNSDomain = strDC & "/" & "DC=" & Replace(Mid(strDC, InStr(strDC, ".") + 1), ".", ",DC=")
            strObjectToGet = arrGroupBits(1)
      Else
            Set objRootDSE = GetObject("LDAP://RootDSE")
            strDNSDomain = objRootDSE.Get("defaultNamingContext")
      End If
 
      strDetails = ""
      strBase = "<LDAP://" & strDNSDomain & ">"
      ' Setup ADO objects.
      Set adoCommand = CreateObject("ADODB.Command")
      Set ADOConnection = CreateObject("ADODB.Connection")
      ADOConnection.Provider = "ADsDSOObject"
      ADOConnection.Open "Active Directory Provider"
      adoCommand.ActiveConnection = ADOConnection
 
 
      ' Filter on user objects.
      'strFilter = "(&(objectCategory=person)(objectClass=user))"
      strFilter = "(&(objectClass=" & strObjectType & ")(" & strSearchField & "=" & strObjectToGet & "))"
 
      ' Comma delimited list of attribute values to retrieve.
      strAttributes = strCommaDelimProps
      arrProperties = Split(strCommaDelimProps, ",")
 
      ' Construct 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.
      Do Until adoRecordset.EOF
          ' Retrieve values and display.
          For intCount = LBound(arrProperties) To UBound(arrProperties)
                If strDetails = "" Then
                      strDetails = adoRecordset.Fields(intCount).Value
                Else
                      strDetails = strDetails & VbCrLf & adoRecordset.Fields(intCount).Value
                End If
          Next
          ' Move to the next record in the recordset.
          adoRecordset.MoveNext
      Loop
 
      ' Clean up.
      adoRecordset.Close
      ADOConnection.Close
      Get_LDAP_User_Properties = strDetails
 
End Function

Open in new window

hirenvmajithiya

Try "AD Manager Plus" from ManageEngine. trial version will serve your purpose.

sivark14

ASKER

Thanks Rob, It works as expected. Can you make it to work with multiple excel sheets

ASKER CERTIFIED SOLUTION

RobSampson

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

sivark14

ASKER

Great It's working.How I can confirm all the id's are created without any error before moving the file.

RobSampson

Hi, I haven't tested this, but give it a shot. Run it from a DOS prompt using
cscript C:\Scripts\CreateUsers.vbs

and it should show you output that describes any errors.

Regards,

Rob.

'Option Explicit
Dim objRootLDAP, objContainer, objUser, objShell,objFso
Dim objExcel, objSpread, intRow
Dim strUser, strOU, strSheet
Dim strCN, strSam, strFirst, strLast, strPWD, Strname, objGroup1,objGroup2,StrHOhome,StrUsrHome,intRunError

StrHOhome = "\\inhosvr01\home\"
strXLFolder = "C:\IDCreation\"
strDoneFolder = "C:\CompletedID\"


If Right(strXLFolder, 1) <> "\" Then strXLFolder = strXLFolder & "\"
If Right(strDoneFolder, 1) <> "\" Then strDoneFolder = strDoneFolder & "\"
Set objFso = CreateObject("Scripting.FileSystemObject")
Set objShell = CreateObject("Wscript.Shell") 


' Open the Excel spreadsheet
Set objExcel = CreateObject("Excel.Application")

For Each objFile In objFso.GetFolder(strXLFolder).Files
	strSheet = objFile.Path
	Set objSpread = objExcel.Workbooks.Open(strSheet, False, False)
	Set objSheet = objSpread.Sheets(1)
	intRow = 2
	
	blnError = False
	
	Do Until objSheet.Cells(intRow,2).Value = ""
		'strSam = Trim(objSheet.Cells(intRow, 1).Value)
		strCN = Trim(objSheet.Cells(intRow, 2).Value) 
		strFirst = Trim(objSheet.Cells(intRow, 3).Value)
		strLast = Trim(objSheet.Cells(intRow, 4).Value)
		strPWD = Trim(objSheet.Cells(intRow, 5).Value)
		Strname = Trim(objSheet.Cells(intRow, 6).Value)
		If Len(strLast) > 6 Then
			strSam = Left(strLast, 6) & Left(strFirst, 1)
		Else
			strSam = strLast & Left(strFirst, 1)
		End If
		If Strname = "ho" Then
			strOU = "OU=Users,OU=CORP," 
		ElseIf Strname ="datacentre" Then
			strou = "OU=Users,OU=MDC,OU=Data Centre,"
		Else
			Wscript.quit
		End If
	
		' Bind to Active Directory, Users container.
		Set objRootLDAP = GetObject("LDAP://rootDSE")
		Set objContainer = GetObject("LDAP://" & strOU & objRootLDAP.Get("defaultNamingContext")) 
	
		' Check if the user already exists
		strDNCheck = ""
		strDNCheck = Get_LDAP_User_Properties("user", "distinguishedName", "cn=" & strCN & "," & objContainer.distinguishedName, "adsPath")
		If InStr(strDNCheck, "LDAP://") > 0 Then
			WScript.Echo "User already exists: " & "cn=" & strCN & "," & objContainer.distinguishedName
			blnError = True
		Else
			strLoginCheck = ""
			intNum = 0
			strOrigSam = strSam
			strLoginCheck = Get_LDAP_User_Properties("user", "samAccountName", strSam, "adsPath")
			While InStr(strLoginCheck, "LDAP://") > 0
				WScript.Echo "Login name already exists: " & strSam & vbCrLf & "for " & strLoginCheck
				intNum = intNum + 1
				strSam = strOrigSam & intNum
				strLoginCheck = Get_LDAP_User_Properties("user", "samAccountName", strSam, "adsPath")
			Wend
			' Build the actual User from data in strSheet.
			WScript.Echo "Creating " & strCN & " with login name " & strSam
			Set objUser = objContainer.Create("User", "cn=" & strCN)
			objUser.sAMAccountName = strSam
			objUser.givenName = strFirst
			objUser.sn = strLast
			On Error Resume Next
			Err.Clear
			objUser.SetInfo
			If Err.Number <> 0 Then
				WScript.Echo "Error creating " & strCN & ". Error " & Err.Number & ": " & Err.Description
				Err.Clear
				blnError = True
			Else
				objUser.userAccountControl = 512
				objUser.pwdLastSet = 0
				objUser.SetPassword strPWD
				objUser.SetInfo
				If Err.Number <> 0 Then
					WScript.Echo "Error setting password attributes for " & strCN & ". Error " & Err.Number  & ": " & Err.Description
					Err.Clear
					blnError = True
				Else
					' Update the spreadsheet to reflect the samAccountName change, if any
					objSheet.Cells(intRow, 1).Value = strSam
					Call addgrp
					If Err.Number <> 0 Then
						WScript.Echo "Error adding " & strCN & " to specified groups. Error " & Err.Number  & ": " & Err.Description
						Err.Clear						
						blnError = True
					End If
				End If
			End If
		End If
		intRow = intRow+1
	Loop
	objSpread.Close True
	If blnError = True Then
		WScript.Echo "Errors occurred in " & strSheet
	Else
		WScript.Echo strSheet & " has been processed successfully."
		objFso.MoveFile strSheet, strDoneFolder
	End If
Next

objExcel.Quit 

Sub addgrp
	If Strname = "ho" Then
		Set objGroup1 = GetObject("LDAP://CN=common_Full(HO),CN=Users,DC=test,DC=com")
		Set objGroup2 = GetObject("LDAP://CN=Public_Read_HO,OU=G-File Server Groups,DC=test,DC=com")
		objGroup1.Add(objUser.ADsPath)
		objGroup2.Add(objUser.ADsPath)
		objUser.SetInfo
		StrUsrHome = StrHOhome & Strsam
		ObjFso.CreateFolder StrUsrHome
		If objFSO.FolderExists(StrUsrHome) Then
			objShell.Run "%COMSPEC% /c Echo Y| cacls  " & StrUsrHome & " /C /G test\" & Strsam & ":F"
		End If
	End If
End Sub

Function Get_LDAP_User_Properties(strObjectType, strSearchField, strObjectToGet, strCommaDelimProps)
      
      If InStr(strObjectToGet, "\") > 0 Then
            arrGroupBits = Split(strObjectToGet, "\")
            strDC = arrGroupBits(0)
            strDNSDomain = strDC & "/" & "DC=" & Replace(Mid(strDC, InStr(strDC, ".") + 1), ".", ",DC=")
            strObjectToGet = arrGroupBits(1)
      Else
            Set objRootDSE = GetObject("LDAP://RootDSE")
            strDNSDomain = objRootDSE.Get("defaultNamingContext")
      End If
 
      strDetails = ""
      strBase = "<LDAP://" & strDNSDomain & ">"
      ' Setup ADO objects.
      Set adoCommand = CreateObject("ADODB.Command")
      Set ADOConnection = CreateObject("ADODB.Connection")
      ADOConnection.Provider = "ADsDSOObject"
      ADOConnection.Open "Active Directory Provider"
      adoCommand.ActiveConnection = ADOConnection
 
 
      ' Filter on user objects.
      'strFilter = "(&(objectCategory=person)(objectClass=user))"
      strFilter = "(&(objectClass=" & strObjectType & ")(" & strSearchField & "=" & strObjectToGet & "))"
 
      ' Comma delimited list of attribute values to retrieve.
      strAttributes = strCommaDelimProps
      arrProperties = Split(strCommaDelimProps, ",")
 
      ' Construct 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.
      Do Until adoRecordset.EOF
          ' Retrieve values and display.
          For intCount = LBound(arrProperties) To UBound(arrProperties)
                If strDetails = "" Then
                      strDetails = adoRecordset.Fields(intCount).Value
                Else
                      strDetails = strDetails & VbCrLf & adoRecordset.Fields(intCount).Value
                End If
          Next
          ' Move to the next record in the recordset.
          adoRecordset.MoveNext
      Loop
 
      ' Clean up.
      adoRecordset.Close
      ADOConnection.Close
      Get_LDAP_User_Properties = strDetails
 
End Function

Open in new window