Still celebrating National IT Professionals Day with 3 months of free Premium Membership. Use Code ITDAY17

x
?
Solved

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

Posted on 2011-09-22
3
Medium Priority
?
462 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 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

Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.

Question has a verified solution.

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

This is an addendum to the following article: Acitve Directory based Outlook Signature (http://www.experts-exchange.com/Programming/Languages/Visual_Basic/VB_Script/Q_24950055.html) The script is fine, and works in normal client-server domains…
Welcome back!  My apologies for taking so long to write part two of this series; it's been a long time coming!  As I promised in Part 1, this article will focus on how to locate those elusive AD properties that you are searching for.  Why is this us…
In this video, Percona Solutions Engineer Barrett Chambers discusses some of the basic syntax differences between MySQL and MongoDB. To learn more check out our webinar on MongoDB administration for MySQL DBA: https://www.percona.com/resources/we…
Want to learn how to record your desktop screen without having to use an outside camera. Click on this video and learn how to use the cool google extension called "Screencastify"! Step 1: Open a new google tab Step 2: Go to the left hand upper corn…
Suggested Courses

688 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