' From the book "Active Directory, Third Edition" 
' ISBN: 0-596-10173-2

Option Explicit

'**********************************************************************
'WshShell::Run constants
'**********************************************************************
Const vbMinimizedNoFocus = 6

'**********************************************************************
'Flag constants. See the previous sidebar on "Boolean Arithmetic with
'Hexadecimal Values."
'**********************************************************************
Const UF_SCRIPT = &H1
Const UF_ACCOUNTDISABLE = &H2
Const UF_HOMEDIR_REQUIRED = &H8
Const UF_PASSWD_NOTREQD = &H20
Const UF_PASSWORD_CANT_CHANGE = &H40
Const UF_ENCRYPTED_TEXT_PASSWORD_ALLOWED = &H80
Const UF_DONT_EXPIRE_PASSWD = &H10000
Const UF_MNS_LOGON_ACCOUNT = &H20000
Const UF_SMARTCARD_REQUIRED = &H40000
Const UF_TRUSTED_FOR_DELEGATION = &H80000
Const UF_NOT_DELEGATED = &H100000

Const ADS_PROPERTY_UPDATE = 2

Dim objDomain, objUser, fso, intUserFlags, intNewUserFlags
Dim fldUserHomedir, wshShell

Set objDomain = GetObject("LDAP://cn=Users,dc=mycorp,dc=com")
Set objUser = objDomain.Create("user","cn=vlaunders")
objUser.Put "sAMAccountName", "vlaunders"
objUser.Put "userPrincipalName", "vlaunders@mycorp.com"

'**********************************************************************
'Write the newly created object out from the property cache and read
'all the properties for the object, including the ones set by the
'system on creation
'**********************************************************************
objUser.SetInfo
objUser.GetInfo

'**********************************************************************
'Set the password
'**********************************************************************
objUser.SetPassword "thepassword"
'**********************************************************************
'Set the properties
'**********************************************************************
objUser.AccountDisabled = False
objUser.AccountExpirationDate = "02/05/01"
objUser.Description = "My description goes here!"
objUser.LoginScript = "login.vbs"
objUser.Profile = "\\MYDOMAIN\DFS\Users\vlaunders\profile"
objUser.PasswordRequired = True
objUser.TelephoneHome = Array("0123-555-7890")
objUser.PutEx ADS_PROPERTY_UPDATE, "otherHomePhone", _
  Array("0123 555 7891", "0123 555 7892")
objUser.TelephoneNumber = Array("0123 555 7890")
objUser.PutEx ADS_PROPERTY_UPDATE, "otherTelephone", _
  Array("0123 555 7891", "0123 555 7892")
objUser.TelephoneMobile = Array("0123 555 7890")
objUser.PutEx ADS_PROPERTY_UPDATE, "otherMobile", _
  Array("0123 555 7891", "0123 555 7892")
objUser.NamePrefix = "Ms."
objUser.FirstName = "Victoria"
objUser.LastName = "Launders"
objUser.DisplayName = "Victoria Launders"

'**********************************************************************
'Set the drive that you'll map to
'**********************************************************************
objUser.HomeDirectory = "\\MYDOMAIN\DFS\Users\vlaunders"
objUser.Put "homeDrive", "Z:"

'**********************************************************************
'Set all the properties for the user and read back the data, including
'any defaults, so that you can set the flags
'**********************************************************************
objUser.SetInfo
objUser.GetInfo

'**********************************************************************
'Make sure the password never expires
'**********************************************************************
intUserFlags = objUser.Get("userAccountControl")
intNewUserFlags = intUserFlags Or UF_DONT_EXPIRE_PASSWD
objUser.Put "userAccountControl", intNewUserFlags
objUser.SetInfo

'**********************************************************************
'Create the home directory
'**********************************************************************
Set fso = CreateObject("Scripting.FileSystemObject")
If Not fso.FolderExists("\\MYDOMAIN\DFS\Users\vlaunders") Then
Set fldUserHomedir = fso.CreateFolder("\\MYDOMAIN\DFS\Users\vlaunders")
End If

'**********************************************************************
'Set full rights for the user to the home directory
'**********************************************************************
Set wshShell = WScript.CreateObject("Wscript.Shell")
wshShell.Run "cacls.exe \\MYDOMAIN\DFS\Users\vlaunders /e /g vlaunders:F", 
vbMinimizedNoFocus, True