VBScript to create new users works but fails on assigning folder permissions

Posted on 2011-09-22
Last Modified: 2012-05-12
Hi the following script works perfectly except for setting the permissions on the users home folder.  Can anyone help with fixing this please?
As an added complexity it sometimes works for one user but then not for the next or further ones?  As this will be part of an HTA I can't use WScript.Sleep
' CreateUsers.vbs

Option Explicit

Dim objExcel, strExcelPath, objSheet, strUser
Dim strLast, strFirst, strMiddle, strPW, intRow, intCol
Dim strGroupDN, objUser, objGroup, objContainer
Dim strCN, strNTName, strContainerDN, strhouseIdentifier
Dim strHomeFolder, strHomeDrive, objFSO, objShell
Dim intRunError, strNetBIOSDomain, strDNSDomain
Dim objRootDSE, objTrans, strLogonScript, strUPN
Dim strdisplayName, strtelephoneNumber, strtitle
Dim strdepartment, strdescription, strphysicalDeliveryOfficeName
Dim strstreetAddress, strcompany, strl, strst
Dim strpostalCode, strc, strco, strwWWHomePage
Dim stro, strdepartmentNumber, strcountryCode
Dim objOU, strattribute

' Constants for the NameTranslate object.
Const ADS_NAME_TYPE_1779 = 1

' Specify spreadsheet.
strExcelPath = "C:\New Starter Scripts\Test\NewUsers1.xlsx"

' Specify DN of container where users created.
strContainerDN = "ou=Newusers,"

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objShell = CreateObject("Wscript.Shell")

' Determine DNS domain name from RootDSE object.
Set objRootDSE = GetObject("LDAP://RootDSE")
strDNSDomain = objRootDSE.Get("DefaultNamingContext")

' Use the NameTranslate object to find the NetBIOS domain name
' from the DNS domain name.
Set objTrans = CreateObject("NameTranslate")
objTrans.Init ADS_NAME_INITTYPE_GC, ""
objTrans.Set ADS_NAME_TYPE_1779, strDNSDomain
strNetBIOSDomain = objTrans.Get(ADS_NAME_TYPE_NT4)
' Remove trailing backslash.
strNetBIOSdomain = Left(strNetBIOSDomain, Len(strNetBIOSDomain) - 1)

' Open spreadsheet.
Set objExcel = CreateObject("Excel.Application")

On Error Resume Next
objExcel.Workbooks.Open strExcelPath
If (Err.Number <> 0) Then
    On Error GoTo 0
    Msgbox("Unable to open spreadsheet " & strExcelPath)

End If
On Error GoTo 0
Set objSheet = objExcel.ActiveWorkbook.Worksheets(1)

' Bind to container where users to be created.
On Error Resume Next
Set objContainer = GetObject("LDAP://" & strContainerDN)
If (Err.Number <> 0) Then
    On Error GoTo 0
    MsgBox("Unable to bind to container: " & strContainerDN)

End If
On Error GoTo 0

' Start with row 2 of spreadsheet.
' Assume first row has column headings.
intRow = 2

' Read each row of spreadsheet until a blank value
' encountered in column 1.
' For each row, create user and set attribute values.
Do While objSheet.Cells(intRow, 1).Value <> ""
    ' Read values from spreadsheet for this user.
    strFirst = Trim(objSheet.Cells(intRow, 1).Value)
    strMiddle = Trim(objSheet.Cells(intRow, 2).Value)
    strLast = Trim(objSheet.Cells(intRow, 3).Value)
    strPW = Trim(objSheet.Cells(intRow, 4).Value)
    strCN = Trim(objSheet.Cells(intRow, 5).Value)
    strNTName = Trim(objSheet.Cells(intRow, 6).Value)
    strUPN = Trim(objSheet.Cells(intRow, 7).Value)
    strHomeFolder = Trim(objSheet.Cells(intRow, 8).Value)
    strHomeDrive = Trim(objSheet.Cells(intRow, 9).Value)
    strLogonScript = Trim(objSheet.Cells(intRow, 10).Value)
    strtitle = Trim(objSheet.Cells(intRow, 11).Value)
    strdepartment = Trim(objSheet.Cells(intRow, 12).Value)
    strdescription = Trim(objSheet.Cells(intRow, 13).Value)
    strphysicalDeliveryOfficeName = Trim(objSheet.Cells(intRow, 14).Value)
    strdisplayName = Trim(objSheet.Cells(intRow, 15).Value)
    strstreetAddress = Trim(objSheet.Cells(intRow, 16).Value)
    strcompany = Trim(objSheet.Cells(intRow, 17).Value)
    strl = Trim(objSheet.Cells(intRow, 18).Value)
    strst = Trim(objSheet.Cells(intRow, 19).Value)
    strpostalCode = Trim(objSheet.Cells(intRow, 20).Value)
    strcountryCode = Trim(objSheet.Cells(intRow, 21).Value)
    strc = Trim(objSheet.Cells(intRow, 22).Value)
    strco = Trim(objSheet.Cells(intRow, 23).Value)
    strwWWHomePage = Trim(objSheet.Cells(intRow, 24).Value)
    stro = Trim(objSheet.Cells(intRow, 25).Value)
    strdepartmentNumber = Trim(objSheet.Cells(intRow, 26).Value)
    strhouseIdentifier = Trim(objSheet.Cells(intRow, 27).Value)
    strtelephoneNumber = Trim(objSheet.Cells(intRow, 28).Value)
    ' Create user object.
    On Error Resume Next
    Set objUser = objContainer.Create("user", "cn=" & strCN)
    If (Err.Number <> 0) Then
        On Error GoTo 0
        MsgBox("Unable to create user with cn: " & strCN)
        On Error GoTo 0
        ' Assign mandatory attributes and save user object.
        If (strNTName = "") Then
            strNTName = strCN
        End If
        objUser.sAMAccountName = strNTName
        On Error Resume Next
        If (Err.Number <> 0) Then
            On Error GoTo 0
            MsgBox("Unable to create user with NT name: " & strNTName)
            ' Set password for user.
            objUser.SetPassword strPW
            If (Err.Number <> 0) Then
                On Error GoTo 0
                MsgBox("Unable to set password for user " & strNTName)
            End If
            On Error GoTo 0
            ' Enable the user account.
            objUser.AccountDisabled = False
            If (strFirst <> "") Then
                objUser.givenName = strFirst
            End If
            ' Assign values to remaining attributes.
            If (strMiddle <> "") Then
                objUser.initials = strMiddle
            End If
            If (strLast <> "") Then
       = strLast
            End If
            If (strUPN <> "") Then
                objUser.userPrincipalName = strUPN
            End If
            If (strHomeDrive <> "") Then
                objUser.homeDrive = strHomeDrive
            End If
            If (strHomeFolder <> "") Then
                objUser.homeDirectory = strHomeFolder
            End If
            If (strLogonScript <> "") Then
                objUser.scriptPath = strLogonScript
            End If
            If (strtitle <> "") Then
            	objUser.title = strtitle
            End If
            If (strdepartment <> "") Then
            	objUser.department = strdepartment
            End If
            If (strdescription <> "") Then
            	objUser.description = strdescription
            End If
            If (strphysicalDeliveryOfficeName <> "") Then
            	objUser.physicalDeliveryOfficeName = strphysicalDeliveryOfficeName
            End If
            If (strdisplayName <> "") Then
            	objUser.displayName = strdisplayName
            End If
            If (strstreetAddress <> "") Then
            	objUser.streetAddress = strstreetAddress
            End If
            If (strcompany <> "") Then
    = strcompany
            End If
            If (strl <> "") Then
            	objUser.l = strl
            End If
            If (strpostalCode <> "") Then
            	objUser.postalCode = strpostalCode
            End If
            If (strcountryCode <> "") Then
            	objUser.countryCode = strcountryCode
            End If
            If (strc <> "") Then
            	objUser.c = strc
            End If
            If (strco <> "") Then
    = strco
            End If
            If (strwWWHomePage <> "") Then
            	objUser.wWWHomePage = strwWWHomePage
            End If
            If (stro <> "") Then
            	objUser.o = stro
            End If
            If (strdepartmentNumber <> "") Then
            	objUser.departmentNumber = strdepartmentNumber
            End If
            If (strhouseIdentifier <> "") Then
            	objUser.houseIdentifier = strhouseIdentifier
            End If
            If (strtelephoneNumber <> "") Then
            	objUser.telephoneNumber = strtelephoneNumber
            End If
            ' Set password expired. Must be changed on next logon.
            objUser.pwdLastSet = 0
            ' Save changes.
            On Error Resume Next
            If (Err.Number <> 0) Then
                On Error GoTo 0
                MsgBox("Unable to set attributes for user with NT name: " _
                    & strNTName)
            End If
            On Error GoTo 0
           'Create home folder.
            If (strHomeFolder <> "") Then
                If (objFSO.FolderExists(strHomeFolder) = False) Then
                   On Error Resume Next
                    objFSO.CreateFolder strHomeFolder
                    If (Err.Number <> 0) Then
                        On Error GoTo 0
                        MsgBox("Unable to create home folder: " & strHomeFolder)
                    End If
                    On Error GoTo 0
                End If       
                If (objFSO.FolderExists(strHomeFolder) = True) Then
                    ' Assign user permission to home folder.
               intRunError = objShell.Run("%COMSPEC% /c Echo Y| cacls """ _
         & strHomeFolder & """ /e /t /c /g """ & strNTName & """:C", 2, True )
           If (intRunError <> 0) Then
         MsgBox("Error assigning permissions for user " _
           & strNTName & " to home folder " & strHomeFolder)
                    End If
                End If
            End If
        End If
    End If
    ' Increment to next user.
    intRow = intRow + 1

Msgbox("Script Completed, if you recieved errors please review the accounts that were mentioned")

' Clean up.
Set objUser = Nothing
Set objContainer = Nothing
Set objSheet = Nothing
Set objExcel = Nothing
Set objFSO = Nothing
Set objShell = Nothing
Set objTrans = Nothing
Set objRootDSE = Nothing

Open in new window

Question by:coch
  • 2

Expert Comment

ID: 36582850
For setting your ACL's, don't pipe it through comspec - just run the app directly, and use a more up to date version of the program.  CACLS is outdated, use ICACLS or Here is sample snippet of code which I run to set home drive permissions:

strShellCommand = "icacls "& strFilePath & " /grant " & strPrincipalName & ":(OI)(CI)(M)"
ShellExec strShellCommand

Sub ShellExec (Cmd)
intResult = objShell.Run(Cmd, 5, True)
	Select Case intResult
		Case 0 
			'Do Nothing
		Case Else
			WScript.Echo "ERROR : Failure with Shell Command, return code : " & intResult
	End Select
End Sub

Open in new window

ICACLS = Windows Vista, 2008 or newer.

If you need clarification for anything, please ask

Accepted Solution

coch earned 0 total points
ID: 36585728
Thanks for the response.  I appreciate that cacls is outdated, however I dont believe that this is the issue with why it works then doesnt work on the next user in this script.  This appears to be more of a timing issue.  The script loops through the building of the user account and creating the folder then its almost as if its trying to set permissions on the next home folder before the AD account is ready - Is this possible?

I have since updated the script so that it creates the user and home folder and then in the HTA I have added another button to set the permissions on the H drive by writing another script that enumerates all the user accounts in the OU & then reads the home directory path and uses cacls to set the permissions, this works ok

Author Closing Comment

ID: 37815481
I found a work a round by breaking the acript into 3 sepertae functions in the HTA

Featured Post

VMware Disaster Recovery and Data Protection

In this expert guide, you’ll learn about the components of a Modern Data Center. You will use cases for the value-added capabilities of Veeam®, including combining backup and replication for VMware disaster recovery and using replication for data center migration.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

In this article we want to have a look at the directory attributes which are used by Microsoft to store the so called Security Identifiers (SID). These SIDs plays an important role in delegating and granting permissions and in authentication of trus…
I met Paul Devereux (@pdevereux) today when I responded to his tweet asking “Anybody know how to automate adding files from disk to a folder in #outlook  ?”.  I replied back and told Paul that using automation, in this case scripting, to add files t…
This Micro Tutorial will give you a basic overview how to record your screen with Microsoft Expression Encoder. This program is still free and open for the public to download. This will be demonstrated using Microsoft Expression Encoder 4.
Established in 1997, Technology Architects has become one of the most reputable technology solutions companies in the country. TA have been providing businesses with cost effective state-of-the-art solutions and unparalleled service that is designed…

770 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question