'==========================================================================
'CreateADUser.vbs
'Created by Timothy Bourne
'http://www.imric.co.uk
'Last Modified : 25/01/2010
'==========================================================================
'This VBscript will prompt for information and then it will create a new 
'user account based on that information in Active Directory. The user's 
'home drive folder is also created.
'==========================================================================

Option Explicit
Dim provider, OU, domain, fullName
Dim objFSO, objFolder, objShell
Dim objClass, objCNName, objDomain, objUser, objGroup
Dim strUname, strPname, strHomeFolder, strHome, strUser
Dim strSaddress, strLocation, strCounty, strPCode, strCountry
Dim strTelephone, strExNumber, strFax, strEmail
Dim strCompany, strDepartment, strDescription, strScript, strMemberOf, strPassword
Dim intAccValue, intPwdValue, intRunError
Dim arrName

Set objFSO = CreateObject("Scripting.FileSystemObject")
strHomeFolder = "\\server01\data\users\"
provider = "LDAP://"
OU = "OU=Example OU,"
domain = "DC=contoso,DC=com"
objClass = "User"

'Get the User's Name and format it
fullName = InputBox("Enter the user's name (Lastname, Firstname): ")
    arrName = Split(fullName, ", ")
    strUname = mid(arrName(1),1, 1) & mid(arrName(0),1, 7) 'Creates username as 8 characters max
    objCNName = "cn=""" & fullName & """"

'Give the dynamic variables values.
strExNumber = InputBox("Enter the user's telephone extension number:")
strDepartment = InputBox("Enter the user's department:")
strDescription = InputBox("Enter the user's job title:")

'Give the static variables values.
strPname = "@contoso.com"
strSaddress = "Address Line 1" & VbCrLf & _
    "Address Line 2" & VbCrLf & _
    "Address Line 3" & VbCrLf & _
    "Address Line 4"
strLocation = "CityName"
strCounty = "Province Name"
strPCode = "Post / Zip Code"
strCountry = "GB" 'Edit to currect 2 digit country code
strTelephone = "01234 567 " 'Telephone without extention number
strFax = "01234 567 101"
strEmail = "@company.com"
strScript = "logonscript.bat"
strCompany = "Contoso"
strPassword = "Pa$$w0rd."
intPwdValue = "0"
intAccValue = "512"

'Connect into the LDAP and create account.
Set objDomain = GetObject(provider & OU & domain)
Set objUser = objDomain.create(objClass, objCNName)
objUser.Put "sAMAccountName", strUname
objUser.Put "userPrincipalName", strUname & strPname
objUser.SetInfo

'Populate First Name and Last Name fields.
objUser.GetInfo
objUser.DisplayName = fullName
objUser.givenName = arrName(1)
objUser.sn = arrName(0)
objUser.SetInfo

'Populate Address, Telephones & E-mail fields.
objUser.streetAddress = strSaddress
objUser.l = strLocation
objUser.st = strCounty
objUser.postalCode = strPCode
objUser.c = strCountry
objUser.physicalDeliveryOfficeName = strLocation
objUser.telephoneNumber = strTelephone & strExNumber
objUser.facsimileTelephoneNumber = strFax
objUser.mail = arrName(1) & "." & arrName(0) & strEmail 'will create email as Firstname.Lastname@company.com

'Discription
objUser.description = strDescription
objUser.scriptPath = strScript
objUser.company = strCompany
objUser.department = strDepartment
objUser.title = strDescription
objUser.SetInfo

'Set Password & Enable Account
objUser.SetPassword strPassword
objUser.SetInfo
objUser.AccountDisabled = False
objUser.IsAccountLocked = False
objUser.Put "pwdLastSet", CLng(0)
objUser.SetInfo

'Set SIP e-mail address, primary server and enable SIP account. (Live Communications Server)
'objUser.[msRTCSIP-PrimaryUserAddress] = "sip:" & arrName(1) & "." & _ 
'    arrName(0) & strEmail
'objUser.[msRTCSIP-PrimaryHomeServer] = "CN=LC Services,CN=Microsoft," & _ 
'    "CN=LCSSERVER01,CN=Pools,CN=RTC Service,CN=Microsoft,CN=System," & _ 
'    "DC=contoso,DC=com"
'objUser.[msRTCSIP-UserEnabled] = True
'objUser.SetInfo


'Terminal Services (if required)
'objUser.TerminalServicesProfilePath = "\\server01\ts\profiles\" & strUname
'objUser.TerminalServicesHomeDrive = "R:"
'objUser.TerminalServicesHomeDirectory = "\\server01\ts\homedir\" & strUname
'objUser.SetInfo

'Add the user to default groups.
strMemberOf = "Example Group"
AddGroup
strMemberOf = "Example Group 2"
AddGroup

'Run the subroutine to create Home Drive.
CreateHome

'Echo out what was created and when.
WScript.Echo("User " & fullName & " (" & strUname & ") was created at: " & Now)

'Subroutine will add the user to a group.
Sub AddGroup
    Set objGroup = GetObject("LDAP://CN=" & strMemberOf & ",OU=Example OU,DC=contoso,DC=com")
    objGroup.add "LDAP://" & objCNName & ",OU=Example OU,DC=contoso,DC=com"
End Sub

'Subroutine will create a home folder using the username if required.
Sub CreateHome
    If objFSO.FolderExists(strHomeFolder & strUname) Then
        WScript.Echo "Folder already exists, adding permissions anyway..."
		AddPermissions
    Else
        Set objFolder = objFSO.CreateFolder(strHomeFolder & strUname)
        AddPermissions
    End If
End Sub

'Subroutine will give the user modify permissions to the home folder.
Sub AddPermissions
    Set objShell = CreateObject("Wscript.Shell")
    If objFSO.FolderExists(strHomeFolder) Then
    intRunError = objShell.Run("%COMSPEC% /c Echo Y| cacls " _
        & strHomeFolder & strUname & " /e /c /g " & strUname & ":C ", 2, True)
        If intRunError <> 0 Then
            Wscript.Echo "Error assigning permissions for user " _
                & strUname & " to home folder " & strHomeFolder & strUname
        End If
    End If
End Sub