Link to home
Start Free TrialLog in
Avatar of GrandPrix22
GrandPrix22

asked on

Server 2003 AD New User Script With Special Attributes

hello all,
i need to write a script for windows server 2003 that will allow me to add new users to the Active Directory, but not conventionally, as i will soon explain.

This is a full command right now:

dsadd user "CN=ATEST001,OU=local-admins,DC=red,DC=qumranet,DC=com" -display "ATEST001 FAMILYNAME" -pwd 123456 -u RED\administrator -p 123456 -samid ATEST001 -memberof "CN=rdp-admin,OU=local-admins,DC=red,DC=qumranet,DC=com" -upn "ATEST001@red.qumranet.com" -disabled no -pwdneverexpires yes

Parameters that i want to be able to play with in the creation process are:

1. User - an admin or not? i want to give them descriptive name - for example, Axxxx would be an admin, Uxxxx would be a user.

2. Domain name - as you can see above, it is all for RED right now.

3. basic group membership. Right now, it's 'local-admins' (which may not be true for users!)

4. member of which groups: Above, it's rdp-admin. We may want to have others, or more than one


any kind of help would be great.
thanks.
Avatar of Chris Dent
Chris Dent
Flag of United Kingdom of Great Britain and Northern Ireland image


In my opinion you'd be better shifting over to VbScript then, it has a much greater degree of flexibility. The cost is that you have to do more work to get it working and learn at least a little bit of it.

Any thoughts on that route? I can help, but I'm not going to spend a lot of time writing things if you're not remotely interested in it ;)

Chris
Avatar of GrandPrix22
GrandPrix22

ASKER

if it works - i'll give it a shot :]
what do you mean by "The cost is that you have to do more work to get it working and learn at least a little bit of it"?  will the running of the script force me to take part in the process?

Not especially, but if you can't maintain and change it the scope is going to be limited.

Actually creating a User in VbScript is pretty easy though. You create a connection to the OU you'd like to make it in, the call a Create method and set a few of the attributes. e.g.:


Set objOU = GetObject("LDAP://OU=SomeOU,DC=red,DC=qumranet,DC=com")

Set objUser = objOU.Create("user", "CN=ATEST001")
objUser.Put "sAMAccountName", "ATest001"
objUser.Put "givenName", "ATest001"
objUser.Put "sN", "FamilyName"
objUser.Put "displayName", "ATest001 FamilyName"
objUser.Put "userPrincipalName", "ATest001@red.qumranet.com"
objUser.SetInfo

objUser.SetPassword 123456


There are a few ways to set Group Membership, the easiest is to create a connection to the group then add the user:


Set objGroup = GetObject("LDAP://CN=SomeGroup,OU=SomeWhere,DC=red,DC=qumranet,DC=com")
objGroup.Add objUser.ADSPath
Set objGroup = Nothing


All good so far, where it starts to get more complex is when you need to add Exchange Mailboxes, or check that the username you just assigned to your new user isn't already in use.

Equally deciding how you're going to feed the information into the script is important. How were you intended to do that?

Chris
it all looks familiar...that's good :]
My idea regarding the feed of the information was with parameters. All the ones i've discussed + another - how many users I want it to create (for example, 100 users would create from User001 to User100, or something like that).
although you writing a whole new script sounds very helpful, i think we'll make it easier if we focus on the attributes i want to control (with parameters, as aforementioned).
i already wrote most of the script, with exchange mailboxes and such. it'll help a lot if you'll check if it's ok, and help me make the adjustments for the parameters issue.
thanks a lot!!


the script:
'Option Explicit
Dim WshShell, fso
Set WSHShell = WScript.CreateObject("WScript.Shell")
Set fso = CreateObject("Scripting.FileSystemObject")
Set WshNetwork = WScript.CreateObject("WScript.Network")

DomainName = "EnterYourDomainName.com"
OUNamePt1 = "Windows 2000 Users"
OUNamePt2 = "Tunbridge Wells Users"
DefaultPassword = "EnterYourDefaultPassword"
Set dom = GetObject("LDAP://" & DomainName)
InputPrompt1 = "Domain = "&DomainName&vbCrLf&"Container = "&OUName&vbCrLf&vbCrLf&"Enter Users Initials:"
InputPrompt2 = "Domain = "&DomainName&vbCrLf&"Container = "&OUName&vbCrLf&vbCrLf&"Enter Users First Name:"
InputPrompt3 = "Domain = "&DomainName&vbCrLf&"Container = "&OUName&vbCrLf&vbCrLf&"Enter Users Surname:"
InputPrompt4 = "Domain = "&DomainName&vbCrLf&"Container = "&OUName&vbCrLf&vbCrLf&"Enter Users Job Title:"
'InputPrompt5 = "Domain = "&DomainName&vbCrLf&"Container = "&OUName&vbCrLf&vbCrLf&"Please Enter F for Fee Earner or N for Non Fee Earner:"
UserName = InputBox(InputPrompt1, "UserInitials")
FirstName = InputBox(InputPrompt2, "FirstName")
Surname = InputBox(InputPrompt3, "Surname")
Department = InputBox(InputPrompt4, "Job Title")
UserStatus = WshShell.popup("Is this user a Fee Earner",,"User Type",4)
Set usr = dom.Create("user", "CN=" & Surname & ", " & FirstName & ",OU=" & OUNamePt1 & ",OU=" & OUNamePt2)
Set ProfileServer = fso.GetFolder("EnterYourFileServerhome$")

'Create User
usr.put "samAccountName", LCase(UserName)
usr.put "userPrincipalName", FirstName & "." & Surname & "@" & DomainName
usr.put "givenName", FirstName
usr.put "sn", Surname
usr.put "displayName", Surname & ", " & FirstName
usr.put "initials", LCase(Mid(UserName,2,1))
usr.put "description", Department
usr.put "homeDirectory", "EnterYourFileServer" & LCase(UserName) & "$"
usr.put "homeDrive", "H:"
usr.put "profilePath", "EnterYourFileServerprofile$" & LCase(UserName)
usr.setinfo
usr.setpassword DefaultPassword
usr.accountdisabled = False
usr.setinfo

'Create Users Mailbox
Dim oIADSUser
Dim MStore
strDefaultNC = "DC=EnterYourDomainName,DC=com"
Set oIADSUser = GetObject("LDAP://CN=" & Surname & ", " & FirstName & ",OU=Windows 2000 Users,OU=Tunbridge Wells Users,DC=EnterYourDomainName,DC=com")

If UCase(Right(Username,1)) <= Chr(76) Then
 MStore = "Mailboxes A-L"
Else
 MStore = "Mailboxes M-Z"
End If

oIADSUser.CreateMailbox "LDAP://CN=" & MStore & ",CN=First Storage Group,CN=InformationStore,CN=EnterYourMailServer,CN=Servers,CN=EnterYourAdminGroup,CN=Administrative Groups,CN=EnterYourSMTPOrganisationName,CN=Microsoft Exchange,CN=Services,CN=Configuration,DC=EnterYourDomainName,DC=com"
oIADSUser.SetInfo

'Add member to groups
Const ADS_PROPERTY_APPEND = 3

Set objGroup = GetObject("LDAP://CN=Docs_Users,CN=Users,DC=EnterYourDomainName,DC=com")
objGroup.PutEx ADS_PROPERTY_APPEND, "member", Array("CN=" & Surname & ", " & FirstName & ",OU=Windows 2000 Users,OU=Tunbridge Wells Users,DC=EnterYourDomainName,DC=com")
objGroup.SetInfo

Set objGroup = GetObject("LDAP://CN=SuperScout All Users,CN=Users,DC=EnterYourDomainName,DC=com")
objGroup.PutEx ADS_PROPERTY_APPEND, "member", Array("CN=" & Surname & ", " & FirstName & ",OU=Windows 2000 Users,OU=Tunbridge Wells Users,DC=EnterYourDomainName,DC=com")
objGroup.SetInfo


If UserStatus = vbYes Then
 Set objGroup = GetObject("LDAP://CN=Fee Earners,CN=Users,DC=EnterYourDomainName,DC=com")
 objGroup.PutEx ADS_PROPERTY_APPEND, "member", Array("CN=" & Surname & ", " & FirstName & ",OU=Windows 2000 Users,OU=Tunbridge Wells Users,DC=EnterYourDomainName,DC=com")
 objGroup.SetInfo
 UserStatus = WshShell.popup("Is this user a Trainee Solicitor",,"User Type",4)
 
 If UserStatus = vbYes Then
  Set objGroup = GetObject("LDAP://CN=All Solicitors,OU=Exchange Mailing Lists,OU=Tunbridge Wells Users,DC=EnterYourDomainName,DC=com")
  objGroup.PutEx ADS_PROPERTY_APPEND, "member", Array("CN=" & Surname & ", " & FirstName & ",OU=Windows 2000 Users,OU=Tunbridge Wells Users,DC=EnterYourDomainName,DC=com")
  objGroup.SetInfo
 End If
Else
 UserStatus = WshShell.popup("Is this user a standard Non Fee Earner",,"User Type",4)

 If UserStatus = vbYes Then
  Set objGroup = GetObject("LDAP://CN=Non Fee Earners,CN=Users,DC=EnterYourDomainName,DC=com")
 Else
  UserStatus = WshShell.popup("Is this a member of IT",,"User Type",4)
 End If
End If

Wscript.quit

'Create users home directory
If fso.FolderExists(ProfileServer & "" & UserName) = False Then
 fso.CreateFolder(ProfileServer & "" & LCase(UserName))
 fso.CreateFolder(ProfileServer & "" & UserName & "interface")
End If

'Share user home directory
AdminServer = "EnterYourAdminServer"
ShareName = LCase(Username) & "$"
FolderName = "E:usershome" & UserName
Set Services = GetObject("WINMGMTS:{impersonationLevel=impersonate,(Security)}!" & AdminServer & "ROOTCIMV2")
Set SecDescClass = Services.Get("Win32_SecurityDescriptor")
Set SecDesc = SecDescClass.SpawnInstance_()
Set Share = Services.Get("Win32_Share")
Set InParam = Share.Methods_("Create").InParameters.SpawnInstance_()
InParam.Properties_.Item("Access") = SecDesc
InParam.Properties_.Item("Description") = "Home Directory"
InParam.Properties_.Item("Name") = ShareName
InParam.Properties_.Item("Path") = FolderName
InParam.Properties_.Item("Type") = 0
Share.ExecMethod_"Create", InParam

If fso.FileExists("C:winntsystem32adssecurity.dll") = False Then
 fso.CopyFile("EnterYourFileServerinstallsoftwareadsiadssecurity.dll"),("c:winntsystem32")
 WshShell.Run("%comspec% /c regsvr32.exe /s C:winntsystem32adssecurity.dll")
 Wscript.sleep 50000
End If

ReplaceACL ProfileServer & "" & Username,"add(" & UserName & ":F)+add(domain admins:F)"

Set WshShell = Nothing
Set fso = Nothing
Set WshNetwork = Nothing
Set usr = Nothing
Set NewShare = Nothing
Set Services = Nothing
Set SecDescClass = Nothing
Set SecDesc = Nothing
Set Share = Nothing
Set InParam = Nothing
Set sec = Nothing
Set sd = Nothing
Set dacl = Nothing
Set ace = Nothing
Set oIADSUser = Nothing
Set objGroup = Nothing

MsgBox "The creation of user: " & FirstName & " " & Surname & VbCrLf &_
  "has completed without error"


'Functions

'Set permissions on users home directory
Function ReplaceACL(foldernm, permspart)
 foldernm = ProfileServer & "" & Username
 If fso.FolderExists(foldernm)= False Then
  MsgBox "Sorry this folder is not present on the server"
 Else
  ChangeACLS foldernm, permspart, "REPLACE", "FOLDER"
 End If
End Function

'Edit ACLS of specified folder
Function ChangeAcls(FILE,PERMS,REDIT,FFOLDER)

 Const ADS_ACETYPE_ACCESS_ALLOWED = 0
 Const ADS_ACETYPE_ACCESS_DENIED = 1
 Const ADS_ACEFLAG_INHERIT_ACE = 2
 Const ADS_ACEFLAG_SUB_NEW = 9
     
 Set sec = Wscript.CreateObject("ADsSecurity")
 Set sd = sec.GetSecurityDescriptor("FILE://" & FILE)
 Set dacl = sd.DiscretionaryAcl

 If UCase(REDIT)="REPLACE" Then
  For Each existingAce In dacl
  dacl.removeace existingace
  Next
 End If
     
 'break up Perms into individual actions
 cmdArray=split(perms,"+")
   
 For x=0 to ubound(cmdarray)
 tmpVar1=cmdarray(x)
 If UCase(left(tmpVar1,3))="DEL" Then
  ACLAction="DEL"
 Else
  ACLAction="ADD"
 End If

 tmpcmdVar=left(tmpVar1,len(tmpVar1)-1)
 tmpcmdVar=right(tmpcmdVar,len(tmpcmdVar)-4)
 cmdparts=split(tmpcmdVar,":")
 nameVar=cmdparts(0)
 rightVar=cmdparts(1)

 If ACLAction="ADD" Then
  If UCase(FFOLDER)="FOLDER" Then
   addace dacl, namevar, rightvar, ADS_ACETYPE_ACCESS_ALLOWED, ADS_ACEFLAG_SUB_NEW
   addace dacl, namevar, rightvar, ADS_ACETYPE_ACCESS_ALLOWED, ADS_ACEFLAG_INHERIT_ACE
  Else
   addace dacl, namevar, rightvar, ADS_ACETYPE_ACCESS_ALLOWED,0
  End If
 End If
 Next

 For Each ace in dacl
  If instr(ucase(ace.trustee),"NT AUTHORITY") then
   newtrustee=right(ace.trustee, len(ace.trustee)-instr(ace.trustee, ""))
   ace.trustee=newtrustee
  End If
 Next

 sd.DiscretionaryAcl = dacl
 sec.SetSecurityDescriptor sd

End Function

Function addace(dacl,trustee, maskvar, acetype, aceflags)
 ' add ace to the specified dacl
 Const RIGHT_READ = &H80000000
 Const RIGHT_EXECUTE = &H20000000
 Const RIGHT_WRITE = &H40000000
 Const RIGHT_DELETE = &H10000
 Const RIGHT_FULL = &H10000000
 Const RIGHT_CHANGE_PERMS = &H40000
 Const RIGHT_TAKE_OWNERSHIP = &H80000
     
 Set ace = CreateObject("AccessControlEntry")
 ace.Trustee = trustee
 
 Select Case UCase(MaskVar)
 Case "F"
 ace.AccessMask = RIGHT_FULL
 Case "C"
 ace.AccessMask = RIGHT_READ or RIGHT_WRITE or RIGHT_EXECUTE or RIGHT_DELETE
 Case "R"
 ace.AccessMask = RIGHT_READ or RIGHT_EXECUTE
 End Select

 ace.AceType = acetype
 ace.AceFlags = aceflags
 dacl.AddAce ace
End Function

 
i didn't give you a headache did i? :]

No, not at all... lunch time ;)

You can feed parameters in using the WScript.Arguments collection. It doesn't really give you much more than access to them though, you would have to test them to make sure you're getting what you want.

I have a script I use for reporting on mailboxes, this is the parameters section from that. It's quite long, and I'm fairly sure there are bits of it I could rewrite so they're more efficient these days:

Sub UsageText
      Dim strMessage

      strMessage = "Usage:" & VbCrLf & VbCrLf
      strMessage = strMessage & "cscript " & WScript.ScriptName & " <Search String> [-p] [-e] [-gl] "
      strMessage = strMessage & "[-d <Domain Name>]" & VbCrLf & VbTab & VbTab & VbTab
      strMessage = strMessage & "[-f <File Name>] [-l] [-s <Exchange Server>] [-pf]" & VbCrLf & VbTab & VbTab & VbTab
      strMessage = strMessage & "[-u] [-c] [-g] [-m] [-ou <OU Name>] " & VbCrLf & VbTab & VbTab & VbTab
      strMessage = strMessage & "[-co <Company Name>] [-dnonly]" & VbCrLf
      strMessage = strMessage & VbCrLf
      strMessage = strMessage & VbTab & "-p - Limits Search to Primary SMTP Addresses" & VbCrLf
      strMessage = strMessage & VbTab & "-e - Only searches Exact Matches" & VbCrLf
      strMessage = strMessage & VbTab & "-gl - Searches a Global Catalog (Forest-Wide Search)" & VbCrLf
      strMessage = strMessage & VbTab & "-d <Domain Name> - Search an alternate AD Domain" & VbCrLf
      strMessage = strMessage & VbTab & "-f <File Name> - Writes all Output to Specified File" & VbCrLf
      strMessage = strMessage & VbTab & "-l - Lists all SMTP Addresses for each result" & VbCrLf
      strMessage = strMessage & VbTab & "-s <Exchange Server> - Required to Find the Public Folder Path" & VbCrLf
      strMessage = strMessage & VbTab & "-pf - Limits Search to Public Folders Only" & VbCrLf
      strMessage = strMessage & VbTab & "-u - Limits Search to User Objects Only" & VbCrLf
      strMessage = strMessage & VbTab & "-c - Limits Search to Contact Objects Only" & VbCrlf
      strMessage = strMessage & VbTab & "-g - Limits Search to Group Objects Only" & VbCrLf
      strMessage = strMessage & VbTab & "-m - Search mail attribute as well as proxyAddresses" & VbCrLf
      strMessage = strMessage & VbTab & "-ou <OU Name> - Limits Search to within Paths containing OU Name" & VbCrLf
      strMessage = strMessage & VbTab & "-co <Company Name> - Limits Search to Objects with Company Name set" & VbCrLf
      strMessage = strMessage & VbTab & "-dnonly - Returns the Distinguished Name Only for DS Tool Compatibility" & VbCrLf
      strMessage = strMessage & VbTab & VbTab & "dnonly Option Requires File Output" & VbCrLf
      strMessage = strMessage & VbCrLf & "To return all addresses the Wildcard * can be used as follows:" & VbCrLf & VbCrLf
      strMessage = strMessage & VbTab & "cscript " & WScript.ScriptName & " * [<Options>]" & VbCrLf
      strMessage = strMessage & VbCrLf & "Note: Public Folder Path Search can take up to 30 minutes " &_
            "and only works when run as an Exchange Administrator against Exchange 2003 or higher." & VbCrLf
      WScript.Echo strMessage
      WScript.Quit
End Sub

Sub SortArgv
      Dim objArgv, objRootDSE
      Dim strArgv
      Dim booSearchAltDomain
      Dim i, intDomain, intFile, intExchange, intOU, intCompany

      Set objArgv = WScript.Arguments

      If objArgv.Count < 1 Then
            UsageText()
      End If

      booPrimaryOnly = False : booExact = False : booGC = False : booSearchAltDomain = False
      booWriteToFile = False : booList = False : booSearchPFPath = False : booMailAttribute = False
      booSearchPFOnly = False : booRestrictToOU = False : booRestrictToCompany = False
      booSearchUsersOnly = False : booSearchContactsOnly = False : booSearchGroupsOnly = False : booReturnDNOnly = False
      
      strSearchPattern = objArgv(0)
      If strSearchPattern = "*" Then
            strSearchPattern = ""
      End If

      i = 0

      For Each strArgv in objArgv
            i = i + 1
            If LCase(strArgv) = "-p" Then
                  booPrimaryOnly = True
            End If
            If LCase(strArgv) = "-e" Then
                  booExact = True
            End If
            If LCase(strArgv) = "-gl" Then
                  booGC = True
            End If
            If LCase(strArgv) = "-d" Then
                  booSearchAltDomain = True
                  intDomain = i
            End If
            If LCase(strArgv) = "-f" Then
                  booWriteToFile = True
                  intFile = i
            End If
            If LCase(strArgv) = "-l" Then
                  booList = True
            End If
            If LCase(strArgv) = "-s" Then
                  booSearchPFPath = True
                  intExchange = i
            End If
            If LCase(strArgv) = "-pf" Then
                  booSearchPFOnly = True
            End If
            If LCase(strArgv) = "-u" Then
                  booSearchUsersOnly = True
            End If
            If LCase(strArgv) = "-c" Then
                  booSearchContactsOnly = True
            End If
            If LCase(strArgv) = "-g" Then
                  booSearchGroupsOnly = True
            End If
            If LCase(strArgv) = "-m" Then
                  booMailAttribute = True
            End If
            If LCase(strArgv) = "-ou" Then
                  booRestrictToOU = True
                  intOU = i
            End If
            If LCase(strArgv) = "-co" Then
                  booRestrictToCompany = True
                  intCompany = i
            End If
            If LCase(strArgv) = "-dnonly" Then
                  booReturnDNOnly = True
            End If
      Next
      
      If booReturnDNOnly = True And booWriteToFile = False Then
            UsageText()
      End If

      If (objArgv.Count > 1) And (booPrimaryOnly = False) And (booExact = False) _
            And (booGC = False) And (booSearchAltDomain = False) And (booWriteToFile = False) _
            And (booList = False) And (booSearchPFPath = False) And (booSearchPFOnly = False) _
            And (booMailAttribute = False) And (booRestrictToOU = False) _
            And (booRestrictToCompany = False) And (booSearchUsersOnly = False) _
            And (booSearchContactsOnly = False) And (booSearchGroupsOnly = False) _
            And (booReturnDNOnly = False) Then
                  UsageText()
      End If

      If booSearchAltDomain = True Then
            If objArgv.Count < (intDomain +  1) Then
                  UsageText()
            Else
                  strDomainName = "DC=" & Replace(objArgv(intDomain), ".", ",DC=")
                  PrefixDC strDomainName
            End If
      Else
            Set objRootDSE = GetObject("LDAP://RootDSE")
            If booGC = True Then
                  strDomainName = objRootDSE.Get("rootDomainNamingContext")
            Else
                  strDomainName = objRootDSE.Get("defaultNamingContext")
            End If
            Set objRootDSE = GetObject("LDAP://RootDSE")
      End If

      If booWriteToFile = True Then
            If objArgv.Count < (intFile + 1) Then
                  UsageText()
            Else
                  strFileName = objArgv(intFile)
            End If
      End If

      If booSearchPFPath = True Then
            If objArgv.Count < (intExchange + 1) Then
                  UsageText()
            Else
                  strExchange = objArgv(intExchange)
            End If
      End If

      If booRestrictToOU = True Then
            If objArgv.Count < (intOU + 1) Then
                  UsageText()
            Else
                  strRestrictToOU = objArgv(intOU)
            End If
      End If

      If booRestrictToCompany = True Then
            If objArgv.Count < (intCompany + 1) Then
                  UsageText()
            Else
                  strRestrictToCompany = objArgv(intCompany)
            End If
      End If

      If strSearchPattern = "" And (booPrimaryOnly = True Or booExact = True) Then
            UsageText()
      End If

      Set objArgv = Nothing      
End Sub


In addition to that I have a number of functions which run in our own User Creation script to simplify certain aspects.

This one checks and generates a Username for our new user:


Function GenerateUserName(strGivenName, strSN)
      Dim objUserCheck, objNetwork
      Dim strUserName
      Dim i

      Set objNetwork = CreateObject("WScript.Network")
      On Error Resume Next
      For i = 1 to 3
            strUserName = strSN & Left(strGivenName, i)
            Err.Clear
            Set objUserCheck = GetObject("WinNT://" & objNetwork.UserDomain &_
                  "/" & strUserName & ", user")
            If Err.Number <> 0 Then
                  Exit For
            Else
                  strUserName = "Duplicate"
            End If
      Next
      Set objNetwork = Nothing
      On Error Goto 0
      GenerateUserName = strUserName
End Function


Another to pick up a Distinguished Name for a Group from it's name so we don't have to hard-code those:

Function GetGroupDN(strGroup)
      Dim objNameTranslate, objNetwork
      Dim strDomain

      On Error Resume Next

      Set objNameTranslate = CreateObject("NameTranslate")
      Set objNetwork = CreateObject("WScript.Network")

      strDomain = objNetwork.UserDomain

      objNameTranslate.Init ADS_NAME_INITTYPE_GC, ""
      objNameTranslate.Set ADS_NAME_TYPE_NT4, strDomain & "\" & strGroup
      strGroup = objNameTranslate.Get(ADS_NAME_TYPE_1779)

      Set objNameTranslate = Nothing
      Set objNetwork = Nothing

      On Error Goto 0

      GetGroupDN = strGroup
End Function


Although the same function can be used to find any AD object that is also represented as such in WinNT (users, computers and groups).

Chris
that seems like what i was looking for.
so, assuming i want to create 100 users, all normal users (or admins. it matters only for their names), under domain name "red", with a basic group membership to, say, "QA", and make them members of "rdp-admins" and "qa".
what exactly do i need to type in order to receive the wanted result?
that is, what is the complete doe, and what is the exact text i need to type in?
thanks!!

You could easily create a hundred arbitary users, it's just that's fairly meaningless when it comes to using them for more than testing.

But if you do, are you wanting it to generate random usernames then? Taking your earlier example that would be ATest001 to ATest100?

Or you could have the new users names sitting in a csv file which could be read very easily.

Or you could pass them into the script as individual parameters (not my favourite method for this kind of thing).

Or perhaps a Database?

It's just a method of figuring out how you want to read the script. The current Input Boxes look like they'd work as well, but it's a bit longwinded.

Chris
random usernames it is. as you said it - Users would be Uxxx and Admins Axxx.
the purpose IS testing, as you wisely mentioned.

i'm not quite sure what to do in order to assemble all codes together and how to make it work with the right parameters. could you simplify that?
thanks!

Yeah, give me a few hours. Might take a bit longer because I'm off home soon, but I can pick it up from there as well.

Chris
you're the best :]
thanks a lot!

I'm sure this will need some more work. See what you think about this lot. I designed it so you could potentially swap out the way it decides who \ what to create and still keep the creation subroutines intact.

Completely untested... bit late at night now ;)


Option Explicit

' Script Constants

Const OU_PATH = "OU=Windows 2000 Users,OU=Tunbridge Wells Users"

'
' Functions
'

Function UserExists(strUserName)
      ' Return Type: Boolean
      ' Checks for a user in the connected domain
     
      Dim objNetwork, objUser
      Dim booUserExists

      booUserExists = False

      On Error Resume Next : Err.Clear
      Set objNetwork = CreateObject("WScript.Network")
      Set objUser = GetObject("WinNT://" & objNetwork.UserDomain & "/" & strUserName & ", user")
      If Err.Number = 0 Then
            booUserExists = True
      End If
      On Error Goto 0
      Set objUser = Nothing
      Set objNetwork = Nothing
     
      UserExists = booUserExists
End Function

'
' Subroutines
'

Sub UsageText()
      Dim strMessage

      strMessage = "Usage:" & VbCrLf & VbCrLf
      strMessage = strMessage & "cscript " WScript.ScriptName & " -g <GivenName> -i <Initials>" & VbCrLf
      strMessage = strMessage & VbTab & "-s <Surname> -j <JobTitle> -n <NumberOfUsers>" & VbCrLf
      strMessage = strMessage & VbTab & "[-d <DomainName>]" & VbCrLf
      strMessage = strMessage & VbCrLf
      strMessage = strMessage & VbTab & "-d <Domain Name> - Run for an alternate AD Domain" & VbCrLf
      WScript.Echo strMessage
      WScript.Quit
End Sub

Sub SortArgv
      Dim objArgv, objRootDSE
      Dim strArgv
      Dim booAltDomain, booPassword, booGivenName, booInitials, booSurname, booJobTitle, booNumber
      Dim i, intAltDomain, intPassword, intGivenName, intInitials, intSurname, intJobTitle, intNumber

      Set objArgv = WScript.Arguments

      If objArgv.Count < 1 Then
            UsageText
      End If

      booAltDomain = False : booPassword = False : booGivenName = False : booInitials = False
      booSurname = False : booJobTitle = False : booNumber = False
      
      i = 0

      For Each strArgv in objArgv
            i = i + 1
            If LCase(strArgv) = "-d" Then
                  booAltDomain = True : intAltDomain = i
            ElseIf LCase(strArgv) = "-p" Then
                  booPassword = True : intPassword = i
            ElseIf LCase(strArgv) = "-g" Then
                  booGivenName = True : intGivenName = i
            ElseIf LCase(strArgv) = "-i" Then
                  booInitials = True : intInitials = i
            ElseIf LCase(strArgv) = "-s" Then
                  booSurname = True : intSurname = i
            ElseIf LCase(strArgv) = "-j" Then
                  booJobTitle = True : intJobTitle = i
            ElseIf LCase(strArgv) = "-n" Then
                  booNumber = True : intNumber = i
            End If
      Next
      
      If (objArgv.Count > 1) And (booPassword = False) And (booGivenName = False) _
                  And (booInitials = False) And (booSurname = False) And (booJobitle = False) _
                  And (booNumber = False) Then
            UsageText
      End If
      
      ' Check has minimum number of required arguments (+ 1 for to account for Index starting at 0. + 6 for required values)

      If objArgv.Count < (i + 1 + 6) Then
            UsageText
      End If

      If booAltDomain = True Then
            If objArgv.Count < (intAltDomain +  1) Then
                  UsageText
            Else
                  strDomainName = "DC=" & Replace(objArgv(intAltDomain), ".", ",DC=")
            End If
      Else
            Set objRootDSE = GetObject("LDAP://RootDSE")
            strDomainName = objRootDSE.Get("defaultNamingContext")
            Set objRootDSE = Nothing
      End If

      strPassword = objArgv(intPassword)
      strGivenName = objArgv(intGivenName)
      strInitials = objArgv(intInitials)
      strSurname = objArgv(intSurname)
      strJobTitle = objArgv(intJobTitle)
      strNumber = objArgv(intNumber)
      If Not IsNumeric(strNumber) Then
            UsageText
      End If

      Set objArgv = Nothing      
End Sub

Sub CreateUserData(strPassword, strGivenName, strInitials, strSurname, strJobTitle, strNumber)
      Dim strUserName
      Dim intNumber, i

      intNumber = CInt(strNumber)

      For i = 1 To intNumber
            If i < 10 Then
                  strNumber = "00" & CStr(i)
            ElseIf i => 10 And i < 100 Then
                  strNumber = "0" & CStr(i)
            End If
            strUserName = Left(strGivenName, 1) & strSurname & strNumber

            If UserExists(strUserName) = False And Not objUsers.Exists(strUserName) Then
                  objUser.Add strUserName, Array(strGivenName, strInitials, strSurname,_
                        strJobTitle, strPassword, strNumber)
            End If
      Next
End Sub

Sub CreateUsers
      Dim objUser
      Dim strUserName, strGivenName, strInitials, strSurname, strJobTitle, strPassword, strNumber, strCN

      Set objOU = GetObject("LDAP://" & OU_PATH & "," & strDomainName)

      For Each strUsername In objUsers
            strGivenName = objUsers(strUserName)(0)
            strInitials = objUsers(strUserName)(1)
            strSurname = objUsers(strUserName)(2)
            strJobTitle = objUsers(strUserName)(3)
            strPassword = objUsers(strUserName)(4)
            strNumber = objUsers(strUserName)(5)

            On Error Resume Next
            strCN = "CN=" & strGivenName & " " & strSurname & " " & strNumber
            Set objUser = objOU.Create("user", strCN)
            On Error Goto 0
            
            objUser.Put "sAMAccountName", strUserName
            objUser.Put "userPrincipalName", strGivenName & "." & strSurname & "@" &_
                  Replace(Replace(strDomain, ",DC=", "."), "DC=", "")

            objUser.Put "givenName", strGivenName
            objUser.Put "sN", strSurname
            objUser.Put "displayName", strSurname & ", " & strGivenName
            objUser.Put "initials", strInitials
            objUser.Put "description", strJobTitle
            objUser.SetInfo

            objUser.SetPassword strPassword

            Set objGroup = GetObject("LDAP://CN=Docs_Users,CN=Users,DC=EnterYourDomainName,DC=com")
            objGroup.Add objUser.ADSPath
            Set objGroup = Nothing

            Set objGroup = GetObject("LDAP://CN=SuperScout All Users,CN=Users,DC=EnterYourDomainName,DC=com")
            objGroup.Add objUser.ADSPath
            Set objGroup = Nothing

            Set objUser = Nothing
      Next
End Sub

Sub CreateMailboxes
      Dim objUser
      Dim strUser, strGivenName, strSurname, strNumber, strCN, strMailStore

      For Each strUserName in objUsers
            strGivenName = objUsers(strUserName)(0)
            strSurname = objUsers(strUserName)(2)
            strNumber = objUsers(strUserName)(5)

            strCN = "CN=" & strGivenName & " " & strSurname & " " & strNumber

            Set objUser = GetObject("LDAP://" & strCN & "," & OU_PATH & "," & strDomainName)

            If UCase(Left(strSurname)) <= Chr(76) Then
                  strMailStore = "Mailboxes A-L"
            Else
                  strMailStore = "Mailboxes M-Z"
            End If

            objUser.CreateMailbox "LDAP://CN=" & strMailStore & ",CN=First Storage Group,CN=InformationStore," &_
                  "CN=<MailServer>,CN=Servers,CN=<AdminGroup>,CN=Administrative Groups," &_
                  "CN=<ExchangeOrg>,CN=Microsoft Exchange,CN=Services,CN=Configuration," & strDomainName
            objUser.SetInfo
            Set objUser = Nothing
      Next
End Sub

'
' Main Script
'

' Global Variables

Dim objUsers
Dim strDomainName, strPassword, strGivenName, strInitials, strSurname, strJobTitle, strNumber

SortArgv

Set objUsers = CreateObject("Scripting.Dictionary")

CreateUserData(strPassword, strGivenName, strInitials, strSurname, strJobTitle, strNumber)

If objUsers.Count > 0 Then
      CreateUsers
      CreateMailboxes
End If

Set objUsers = Nothing
i'm sorry for being a pain in the ass, just one last question - assuming i want to create what we've talked about (100 Users, all part of a certain group yada yada), what is the command i should type?
many thanks.
ASKER CERTIFIED SOLUTION
Avatar of Chris Dent
Chris Dent
Flag of United Kingdom of Great Britain and Northern Ireland image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
i would have given you 5000 points if i could.
no words to describe how much you helped me.
thanks!!

You're welcome :)

Chris