' -------------------------------------------------------------------------
'       From the book Inside Active Directory, ISBN 0-201-61621-1
'       Copyright (C) 2002 by Addison-Wesley
'       Script by Sakari Kouti (see http://www.kouti.com)
' You have a royalty-free right to use, modify, reproduce and distribute
' this script (and/or any modified version) in any way you find useful,
' provided that you agree that Addison-Wesley or Sakari Kouti has no
' warranty, obligations or liability for the script. If you modify
' the script, you must retain this copyright notice.
' -------------------------------------------------------------------------
Option Explicit

Const UF_SMARTCARD_REQUIRED = &H40000

Call CreateUser("Jack", "Brown")

Sub CreateUser(strFirstName, strLastName)
	Dim objContainer, objUser, objLargeInt, strSAMName, intUserFlags

	Set objContainer = _
		GetObject("LDAP://OU=Sales,DC=sanao,DC=com")

	Set objUser = objContainer.Create("user", _
		"CN=" & strLastName & " " & strFirstName)

	'The Essential Properties
	'-----------------------
	strSAMName = strFirstName & Left(strLastName, 1)
	Call objUser.Put("sAMAccountName", strSAMName)
	Call objUser.Put("userAccountControl", &H200)
	Call objUser.Put("userPrincipalName", _
		strFirstName & "." & strLastName & "@sanao.com")

	objUser.SetInfo
	objUser.SetPassword ("secret")
	objUser.GetInfo

	'The Significant Properties
	'-------------------------
	Call objUser.Put("profilePath", "\\dc1\Prof$\" & strSAMName)
	'We let Group Policy take care of the logon script setting
	Call objUser.Put("homeDirectory", "\\dc1\" & strSAMName)
	Call objUser.Put("homeDrive", "H:")

	'User must NOT change password at next logon
	Set objLargeInt = CreateObject("LargeInteger")
	objLargeInt.LowPart = &HFFFFFFFF
	objLargeInt.HighPart = &HFFFFFFFF
	Call objUser.Put("pwdLastSet", objLargeInt)

	objUser.AccountDisabled = True

	intUserFlags = objUser.Get("userAccountControl")
	intUserFlags = intUserFlags Or UF_SMARTCARD_REQUIRED
	'If we wanted to clear a setting instead of setting it:
	'intUserFlags = intUserFlags And Not UF_SMARTCARD_REQUIRED
	Call objUser.Put("userAccountControl", intUserFlags)

	'The Informational Properties
	'-------------------------
	Call objUser.Put("givenName", strFirstName)
	Call objUser.Put("initials", _
		Left(strFirstName, 1) & Left(strLastName, 1))
	Call objUser.Put("sn", strLastName)
	Call objUser.Put("displayName", strFirstName & " " & strLastName)
	Call objUser.Put("telephoneNumber", "555-4268")
	Call objUser.Put("otherTelephone", Array("555-6122", "555-7991"))

	objUser.SetInfo
	Set objUser = Nothing
End Sub