Tip

VB Script to create users including Exchange mailbox

Please let us know how useful you find this tip by rating it below. Do you have a useful Windows tip, timesaver or workaround to share? Submit it to our tip contest and you could win a prize!


    Requires Free Membership to View

This script will create and configure a user including an Exchange mailbox, create and share home directory (with permissions) and put a user into AD groups.

It requires user input for user initials and a couple of other fields, but can easily be changed to read from a csv file.

 

 '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


This was first published in May 2005

There are Comments. Add yours.

 
TIP: Want to include a code block in your comment? Use <pre> or <code> tags around the desired text. Ex: <code>insert code</code>

REGISTER or login:

Forgot Password?
By submitting you agree to receive email from TechTarget and its partners. If you reside outside of the United States, you consent to having your personal data transferred to and processed in the United States. Privacy
Sort by: OldestNewest

Forgot Password?

No problem! Submit your e-mail address below. We'll send you an email containing your password.

Your password has been sent to:

Disclaimer: Our Tips Exchange is a forum for you to share technical advice and expertise with your peers and to learn from other enterprise IT professionals. TechTarget provides the infrastructure to facilitate this sharing of information. However, we cannot guarantee the accuracy or validity of the material submitted. You agree that your use of the Ask The Expert services and your reliance on any questions, answers, information or other materials received through this Web site is at your own risk.