Solved

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

Posted on 2011-09-22
3
420 Views
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_INITTYPE_GC = 3
Const ADS_NAME_TYPE_NT4 = 3
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,dc=domain.com"

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)
    Else
        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
        objUser.SetInfo
        If (Err.Number <> 0) Then
            On Error GoTo 0
            MsgBox("Unable to create user with NT name: " & strNTName)
        Else
            ' 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
                objUser.sn = 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
            	objUser.company = 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
            	objUser.co = 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
            objUser.SetInfo
            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
Loop

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

' Clean up.
objExcel.ActiveWorkbook.Close
objExcel.Application.Quit
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

0
Comment
Question by:coch
  • 2
3 Comments
 
LVL 9

Expert Comment

by:Lester_Clayton
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
			'WScript.Quit(intResult)
	End Select
End Sub

Open in new window


ICACLS = Windows Vista, 2008 or newer.

If you need clarification for anything, please ask
0
 

Accepted Solution

by:
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
0
 

Author Closing Comment

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

Featured Post

How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

Join & Write a Comment

Unlike scripting languages such as C# where a semi-colon is used to indicate the end of a command, Microsoft's VBScript language relies on line breaks to determine when a command begins and ends. As you can imagine, this quickly results in messy cod…
This script will sweep a range of IP addresses (class c only, 255.255.255.0) and report to a log the version of office installed. What it does: 1.)      Creates log file in the directory the script is run from (if it doesn't already exist) 2.)      Sweep…
This video shows how to remove a single email address from the Outlook 2010 Auto Suggestion memory. NOTE: For Outlook 2016 and 2013 perform the exact same steps. Open a new email: Click the New email button in Outlook. Start typing the address: …
This tutorial demonstrates a quick way of adding group price to multiple Magento products.

707 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

Need Help in Real-Time?

Connect with top rated Experts

19 Experts available now in Live!

Get 1:1 Help Now