[Okta Webinar] Learn how to a build a cloud-first strategyRegister Now

x
?
Solved

AD User Creation from Excel Sheet

Posted on 2011-10-19
6
Medium Priority
?
542 Views
Last Modified: 2012-08-14
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
0
Comment
Question by:sivark14
  • 3
  • 2
6 Comments
 
LVL 65

Expert Comment

by:RobSampson
ID: 36996969
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

0
 
LVL 7

Expert Comment

by:hirenvmajithiya
ID: 36998290
Try "AD Manager Plus" from ManageEngine. trial version will serve your purpose.
0
 

Author Comment

by:sivark14
ID: 37004755
Thanks Rob, It works as expected. Can you make it to work with multiple excel sheets
0
 [eBook] Windows Nano Server

Download this FREE eBook and learn all you need to get started with Windows Nano Server, including deployment options, remote management
and troubleshooting tips and tricks

 
LVL 65

Accepted Solution

by:
RobSampson earned 2000 total points
ID: 37015901
Sure, try this.

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
	
	
	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
		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
			objSheet.Cells(intRow, 1).Value = strSam
			
			Call addgrp
		End If
		intRow = intRow+1
	Loop
	objSpread.Close True
	objFso.MoveFile strSheet, strDoneFolder
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

0
 

Author Comment

by:sivark14
ID: 37158370
Great It's working.How I can confirm all the id's are created without any error before moving the file.
0
 
LVL 65

Expert Comment

by:RobSampson
ID: 37168751
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

0

Featured Post

What is SQL Server and how does it work?

The purpose of this paper is to provide you background on SQL Server. It’s your self-study guide for learning fundamentals. It includes both the history of SQL and its technical basics. Concepts and definitions will form the solid foundation of your future DBA expertise.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

After seeing many questions for JRNL_WRAP_ERROR for replication failure, I thought it would be useful to write this article.
Microsoft Office 365 is a subscriptions based service which includes services like Exchange Online and Skype for business Online. These services integrate with Microsoft's online version of Active Directory called Azure Active Directory.
This tutorial will walk an individual through the steps necessary to join and promote the first Windows Server 2012 domain controller into an Active Directory environment running on Windows Server 2008. Determine the location of the FSMO roles by lo…
Microsoft Active Directory, the widely used IT infrastructure, is known for its high risk of credential theft. The best way to test your Active Directory’s vulnerabilities to pass-the-ticket, pass-the-hash, privilege escalation, and malware attacks …

873 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question