Option Explicit
Dim strUserName
Dim strGroupName
Dim objRootLDAP
Dim objContainer
Dim objNewUser
Dim objNewGroup
Dim objGroup
Dim objUser
Dim objCommand
Dim objConnection
Dim objRecordSet
Dim counterUsers
Dim counterGroups
Dim strName
Dim intStart
Dim intEnd
Dim intUsersInGroup
Dim i
Dim j
Dim intUAC
Const ADS_UF_ACCOUNTDISABLE = 2
strUserName = "testuser"
strGroupName = "testgroup"
counterUsers = 1500
counterGroups = 40
Set objRootLDAP = GetObject("LDAP://rootDSE")
Set objCommand = CreateObject("ADODB.Command")
Set objConnection = CreateObject("ADODB.Connection")
objConnection.Open "Provider=ADsDSOObject;"
objCommand.ActiveConnection = objConnection
' You can give your own OU like LDAP://OU=TestOU instead of LDAP://CN=Users
Set objContainer = GetObject("LDAP://CN=Users," & objRootLDAP.Get("defaultNamingContext"))
' check if object exists
Function QueryAD(strName, strScope)
objCommand.CommandText = _
"SELECT AdsPath FROM 'LDAP://" & _
objRootLDAP.Get("defaultNamingContext") & "' " & _
"WHERE objectCategory='" & strScope & "' " & _
"AND samAccountName = '" & strName & "'"
Set objRecordSet = objCommand.Execute
If objRecordset.RecordCount = 0 then
QueryAD = False
Else
QueryAD = True
End If
End Function
' users
For i = 1 To counterUsers
strName = strUserName & i
If QueryAD(strName, "user") = False Then
Set objNewUser = objContainer.Create("User", "cn=" & strName)
objNewUser.Put "sAMAccountName", strName
objNewUser.Put "givenName", "testuser" & i
objNewUser.Put "sn", "TestUser" & i
objNewUser.Put "displayName", "TestUser" & i
objNewUser.Put "Description", "AD User created by VB Script"
objNewUser.Put "userAccountControl", 544
objNewUser.SetInfo
objNewUser.SetPassword "univentionUCS3.2"
objNewUser.Put "PasswordExpired", CLng(1)
objNewUser.AccountDisabled = FALSE
End If
Next
' groups
For i = 1 To counterGroups
strName = strGroupName & i
If QueryAD(strName, "group") = False Then
Set objNewGroup = objContainer.Create("Group", "cn=" & strName)
objNewGroup.Put "sAMAccountName", strName
objNewGroup.Put "Description", "AD User created by VB Script"
objNewGroup.SetInfo
End If
Next
' add users to group
intUsersInGroup = Int(counterUsers / counterGroups)
intStart = 1
For i = 1 to counterGroups
Set objGroup = GetObject("LDAP://CN=" & strGroupName & i & ",CN=Users," & objRootLDAP.Get("defaultNamingContext"))
For j = intStart to (intStart + intUsersInGroup)
strName = strUserName & j
Set objUser = GetObject("LDAP://CN=" & strName & ",CN=Users," & objRootLDAP.Get("defaultNamingContext"))
If Not objGroup.IsMember(objUser.ADsPath) Then
objGroup.add(objUser.ADsPath)
End If
Next
intStart = intStart + intUsersInGroup
Next
' one user in all groups
For i = 1 to counterGroups
Set objGroup = GetObject("LDAP://CN=" & strGroupName & i & ",CN=Users," & objRootLDAP.Get("defaultNamingContext"))
Set objUser = GetObject("LDAP://CN=" & strUserName & "1" & ",CN=Users," & objRootLDAP.Get("defaultNamingContext"))
If Not objGroup.IsMember(objUser.ADsPath) Then
objGroup.add(objUser.ADsPath)
End If
Next
MsgBox ("New Active Directory User created successfully by using VB Script...")
WScript.Quit