ravenadsl Posted January 28, 2011 Posted January 28, 2011 Hi guys, Can any one help with this script (see below) The script is to look at a .XLS file connect to AD and see if the user exists. if the user dosent exist the user will be created if the user dose exist the user should be updated. This is where i have the problem. i need to define the user before i send the edit. I think some how i need to integrate AD for the current user and then begin editing. its the only bit im not sue how to do. any suggestions would be great feel free to use this code Option Explicit Dim objExcel, strExcelPath, objSheet Dim strLast, strFirst, strMiddle, strPW, intRow, intCol Dim strGroupDN, objUser, objGroup, objContainer Dim strCN, strNTName, strContainerDN Dim strHomeFolder, strHomeDrive, objFSO, objShell Dim intRunError, strNetBIOSDomain, strDNSDomain Dim objRootDSE, objTrans, strLogonScript, strUPN Dim strPreviousDN, blnBound ' 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:\test\test.xls" 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 Wscript.Echo "Unable to open spreadsheet " & strExcelPath Wscript.Quit End If On Error GoTo 0 Set objSheet = objExcel.ActiveWorkbook.Worksheets(1) ' 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 6 (the column for cn). ' For each row, create user and set attribute values. strPreviousDN = "" Do While objSheet.Cells(intRow, 6).Value <> "" ' Read values from spreadsheet to find this user. strContainerDN = Trim(objSheet.Cells(intRow, 1).Value)'Container user should be in strFirst = Trim(objSheet.Cells(intRow, 2).Value) strMiddle = Trim(objSheet.Cells(intRow, 3).Value) strLast = Trim(objSheet.Cells(intRow, 4).Value) strPW = Trim(objSheet.Cells(intRow, 5).Value) strCN = Trim(objSheet.Cells(intRow, 6).Value) strNTName = Trim(objSheet.Cells(intRow, 7).Value)'NT Username strUPN = Trim(objSheet.Cells(intRow, 8).Value) strHomeFolder = Trim(objSheet.Cells(intRow, 9).Value) strHomeDrive = Trim(objSheet.Cells(intRow, 10).Value) strLogonScript = Trim(objSheet.Cells(intRow, 11).Value) MsgBox "all info set" ' If this container is different from the previous, bind to ' the container the user object will be created in. If (strContainerDN <> strPreviousDN) Then On Error Resume Next Set objContainer = GetObject("LDAP://" & strContainerDN) If (Err.Number <> 0) Then On Error GoTo 0 Wscript.Echo "Unable to bind to container: " & strContainerDN Wscript.Echo "Unable to create user with NT1 name: " & strNTName ' Flag that container not bound. strPreviousDN = "" Else On Error GoTo 0 strPreviousDN = strContainerDN End If End If 'Dose user exist? Dim objNetwork Set objNetwork = CreateObject("WScript.Network") Dim strUserName strUserName = objNetwork.UserName strUserName = strNTName Dim objWinntUser On Error Resume Next Set objWinntUser = GetObject("WinNT://" & objNetwork.UserDomain & "/" & strUserName & ",user") If Err Then If Err.Number = "-2147022675" Then MsgBox "The user was not found. User can be created" 'once finished comment out call create() 'start create user Call update() ' start update user Else MsgBox Err.Number & VbCrLf & Err.Description End If Err.Clear Else MsgBox "User already exists. Running user update." 'onced finished comment out call update() 'start update user End If intRow = intRow + 1 Loop Wscript.Echo "Done" Wscript.Quit Sub Update() if (strPreviousDN <> "") Then '################################### 'need to find furrent user to edit '################################### If (Err.Number <> 0) Then On Error GoTo 0 Wscript.Echo "Unable to create user with NT2 name: " & strNTName Else objUser.SetPassword strPW If (Err.Number <> 0) Then On Error GoTo 0 Wscript.Echo "Unable to set password for user " & strNTName End If On Error GoTo 0 MsgBox "password set" 'Assign values to remaining attributes. If (strMiddle <> "") Then objUser.initials = strMiddle End If MsgBox "set middle name" If (strLast <> "") Then objUser.sn = strLast End If MsgBox "set Last name" If (strUPN <> "") Then objUser.userPrincipalName = strUPN End If ' Save changes. MsgBox "saveing Schanes" On Error Resume Next objUser.SetInfo If (Err.Number <> 0) Then On Error GoTo 0 Wscript.Echo "Unable to update attributes for user with NT name: " _ & strNTName End If End If End If End Sub Sub create() ' Proceed if parent container bound. If (strPreviousDN <> "") Then ' Create user object. On Error Resume Next Set objUser = objContainer.Create("user", "cn=" & strCN) If (Err.Number <> 0) Then On Error GoTo 0 Wscript.Echo "Unable to create user with cn: " & strCN 'Unable to creat NT user Error Else On Error GoTo 0 ' Assign mandatory attributes and save user object. If (strNTName = "") Then strNTName = strCN End If objUser.sAMAccountName = strNTName 'Set useraccount name (login username) On Error Resume Next objUser.SetInfo If (Err.Number <> 0) Then On Error GoTo 0 Wscript.Echo "Unable to create user with NT2 name: " & strNTName 'unable to create user account Error Else ' Enable the user account. objUser.AccountDisabled = False If (strFirst <> "") Then 'Set first name objUser.givenName = strFirst End If If (strHomeDrive <> "") Then 'set Home drive objUser.homeDrive = strHomeDrive End If If (strHomeFolder <> "") Then 'set home folder objUser.homeDirectory = strHomeFolder End If If (strLogonScript <> "") Then 'set login script objUser.scriptPath = strLogonScript End If ' Set password expired. Must be changed on next logon. objUser.pwdLastSet = 0 '0=enabled 1=disabled ' Save changes. On Error Resume Next objUser.SetInfo If (Err.Number <> 0) Then On Error GoTo 0 Wscript.Echo "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 Wscript.Echo "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 & " /T /E /C /G " & strNetBIOSDomain _ & "\" & strNTName & ":F", 2, True) If (intRunError <> 0) Then Wscript.Echo "Error assigning permissions for user " _ & strNTName & " to home folder " & strHomeFolder End If End If End If ' Group DN's start in column 12. intCol = 12 Do While objSheet.Cells(intRow, intCol).Value <> "" strGroupDN = Trim(objSheet.Cells(intRow, intCol).Value) ' Attempt to bind to group object DN. blnBound = False On Error Resume Next Set objGroup = GetObject("LDAP://" & strGroupDN) If (Err.Number <> 0) Then On Error GoTo 0 ' Try again converting NT Name to DN. On Error Resume Next objTrans.Set ADS_NAME_TYPE_NT4, strNetBIOSDomain _ & "\" & strGroupDN If (Err.Number <> 0) Then On Error GoTo 0 Wscript.Echo "Unable to bind to group " & strGroupDN Else On Error GoTo 0 strGroupDN = objTrans.Get(ADS_NAME_TYPE_1779) Set objGroup = GetObject("LDAP://" & strGroupDN) blnBound = True End If Else On Error GoTo 0 blnBound = True End If If (blnBound = True) Then objGroup.Add objUser.AdsPath If (Err.Number <> 0) Then On Error GoTo 0 Wscript.Echo "Unable to add user " & strNTName _ & " to group " & strGroupDN End If End If On Error GoTo 0 ' Increment to next group DN. intCol = intCol + 1 Loop End If End If End If End Sub ' Clean up. objExcel.ActiveWorkbook.Close objExcel.Application.Quit Set objUser = Nothing Set objGroup = Nothing Set objContainer = Nothing Set objSheet = Nothing Set objExcel = Nothing Set objFSO = Nothing Set objShell = Nothing Set objTrans = Nothing Set objRootDSE = Nothing
Recommended Posts
Create an account or sign in to comment
You need to be a member in order to leave a comment
Create an account
Sign up for a new account in our community. It's easy!
Register a new accountSign in
Already have an account? Sign in here.
Sign In Now