yellowartist
IS-IT--Management
I am writing a script that will enumerate members of Group1 and put their requested AD properties into a spreadsheet. The script will then bind to each user from that spreadsheet and make the requested modifications.
I am having problems with making some of the modifications.
Problems:
1. It will cycle through the first person and make the requested changes, when it gets to the second one I get an error saying access denied. I have full permissions to all the OU's so I know it is not because of the object residing in an OU I do not have permissions to.
2. When I try to rename the accounts I get an error saying "(null): There is a naming violation. "
I can get it to work with a lab AD and not pulling from a spreadsheet but cannot get it to work in our production AD pulling from a spreadsheet.
3. I am also having problems getting my error capturing to work. I am not getting a error log like I would like.
Any assistance is greatly appreciated! Thanks.
I am having problems with making some of the modifications.
Problems:
1. It will cycle through the first person and make the requested changes, when it gets to the second one I get an error saying access denied. I have full permissions to all the OU's so I know it is not because of the object residing in an OU I do not have permissions to.
2. When I try to rename the accounts I get an error saying "(null): There is a naming violation. "
I can get it to work with a lab AD and not pulling from a spreadsheet but cannot get it to work in our production AD pulling from a spreadsheet.
3. I am also having problems getting my error capturing to work. I am not getting a error log like I would like.
Any assistance is greatly appreciated! Thanks.
Code:
Option Explicit
on error resume Next
Dim objGroup, objuser, objExcel, iRow, strUser, iCol
Dim strExcelPath, objApp, strGroupName, objSheet
Dim StrDay, StrYear, StrMonth
DIM UID, PWD, LDAPPATH, objou
Dim Strgrpkst, strCN, StrSAM, StrDN
Dim StrUPN, StrDisplay, StrDate, STRou, obj
Dim strLogErrorText, strErrorFile
Dim fso2, fsoFile2, objfso
Dim StrSN, StrGN, StrName
'Constants for passing Credentials
Const ADS_SECURE_AUTHENTICATION = 1
Const ADS_USE_ENCRYPTION = 2
'Constant for modifing an array
Const ADS_PROPERTY_APPEND = 3
'Prompt for userid
UID = InputBox("User Name with domain prefix (domain\admcn):")
'Prompt for password
PWD = InputBox("Please enter your password:")
Dim LDAP 'As IADsOpenDSObject
Set LDAP = GetObject("LDAP:")
Set obj = LDAP.OpenDSObject(LDAPPATH, uid, pwd, _
ADS_SECURE_AUTHENTICATION)
if err.number<>0 Then
wscript.echo "Error connecting to AD " & err.number, err.description
err.Clear
Wscript.Quit(0)
End If
'String for date mmddyy
StrMonth = Month(Date)
StrYear = Right(Year(Date),2)
StrDay = Day(Date)
CreateWorkLog
WScript.Sleep (1500)
ModifyAcct
WScript.Sleep (1500)
Sub CreateWorkLog()
'Path to create spreadsheet
strExcelPath = "i:\" & StrMonth & StrDay & StrYear & "_" & "work_Log" & ".xls"
LDAPPATH = "LDAP://CN=group,OU=Groups,OU=KBS,DC=mydomain,DC=com"
'KST Group to not disable accounts or reset passwords
Strgrpkst = "LDAP://CN=Group2,OU=Groups,OU=KBS,DC=mydomain,DC=com"
' Create a new Excel File
Set objExcel = CreateObject("Excel.Application")
' Create a new workbook.
objExcel.Workbooks.Add
' Bind to worksheet.
Set objSheet = objExcel.ActiveWorkbook.Worksheets(1)
objSheet.Name = "Work_Log"
' Populate spreadsheet cells with user attributes.
'Group to pull members from GG_ES_ACCT_ADMIN
Set objGroup = GetObject(LDAPPATH)
If err.number<>0 Then
WScript.Echo "Error connecting to" & LDAPPATH
End If
Set objExcel = CreateObject("Excel.Application")
With objExcel
.SheetsInNewWorkbook = 1
.Workbooks.Add
.Visible = False
iRow=1
'Bind to the user and pull the following information
For Each strUser in objGroup.Member
Set objuser = GetObject("LDAP://" & strUser)
StrSN = (objuser.sn)
StrGN = (objuser.givenName)
StrDN = (objuser.distinguishedName)
StrName = ("CN=" & StrSN & "\, " & StrGN & ",")
STRou = Replace(StrDN, StrName, "")
.Cells(irow,1) = (objUser.CN)
.Cells(irow,2) = (objUser.sAMAccountName)
.Cells(irow,3) = (objUser.distinguishedName)
.Cells(irow,4) = (objUser.homeDirectory)
.Cells(iRow,5) = (objUser.homeMDB)
.Cells(iRow,6) = (objuser.mailNickname)
.Cells(iRow,7) = (Join(objUser.proxyAddresses))
.Cells(iRow,8) = (Join(objUser.memberof))
.Cells(iRow,9) = (objuser.ExtensionAttribute1)
.Cells(iRow,10) = (objuser.ExtensionAttribute5)
.Cells(iRow,11) = (objuser.msExchHomeServerName)
.Cells(iRow,12) = (objuser.legacyExchangeDN)
.Cells(iRow,13) = (objuser.userPrincipalName)
.Cells(iRow,14) = (objuser.DisplayName)
.Cells(iRow,15) = (objuser.sn)
.Cells(iRow,16) = (objuser.givenName)
.Cells(iRow,17) = STRou
irow=irow + 1
Next
End With
If err.number<>0 Then
WriteErrorLog "Error connecting to" & strUser
End If
' Save the spreadsheet, close the workbook and exit.
objExcel.ActiveWorkbook.SaveAs strExcelPath
objExcel.ActiveWorkbook.Close
objExcel.Application.Quit
'WScript.Echo "Spreadsheet Created"
' If err.number<>0 Then
' WScript.Echo "Error saving " & strExcelPath
' End If
End Sub
Sub ModifyAcct()
'String for date mmddyy
StrMonth = Month(Date)
StrYear = Right(Year(Date),2)
StrDay = Day(Date)
wscript.echo "start script"
strExcelPath = "i:\" & StrMonth & StrDay & StrYear & "_" & "work_Log" & ".xls"
' Open the Excel spreadsheet
Set objExcel = CreateObject("Excel.Application")
Set objSpread = objExcel.Workbooks.Open(strExcelPath)
intRow = 1
' Here is the 'DO...Loop' that cycles through the cells
' Note intRow, x must correspond to the column in strSheet
'This part marks the accounts for deletion.
Do Until objExcel.Cells(intRow,1).Value = ""
strCN = Trim(objExcel.Cells(intRow, 1).Value)
StrSAM = Trim(objExcel.Cells(intRow, 2).Value)
StrDN = Trim(objExcel.Cells(intRow, 3).Value)
StrUPN = Trim(objExcel.Cells(intRow, 13).Value)
StrDisplay = Trim(objExcel.Cells(intRow, 14).Value)
STRou = Trim(objExcel.Cells(intRow, 17).Value)
strougroup = "CN=Group3,OU=Groups,OU=KBS,DC=mydomain,DC=com"
StrNewCN = (StrMonth & "/" & StrDay & "/" & StrYear & " " & strdisplay)
WScript.Echo STRou
Set objUser = GetObject("LDAP://" & strdn)
'Wscript.echo "LDAP://" & StrDN
objUser.Put "sAMAccountName", ("1" & strSam)
objUser.Put "DisplayName", StrNewCN
objUser.Put "userPrincipalName", ("1" & strUPN)
objUser.Put "extensionAttribute5", "EXEMPT"
objuser.setinfo
If err.number <> 0 Then
WriteErrorlog "Unable to modify " & strCN
End If
'If user is not In the GG_ES_ACCT_ADMIN_KST then reset password and disable account
If objGroup <> Strgrpkst Then
'If Objuser.memberof <> Strgrpkst Then
objUser.SetPassword "i5A2sj*!"
objUser.userAccountControl = 514
objuser.setInfo
If err.number <> 0 Then
WriteErrorlog "Unable to disable " & strCN
End If
End If
'Hide From GAL
objuser.put "msExchHideFromAddressLists", True
objuser.setInfo
If err.number <> 0 Then
WriteErrorlog "Unable to hide from GAL " & strCN
End If
'Mailbox restrictions
Objuser. putEX ADS_PROPERTY_UPDATE, "authOrig", Array("CN=*DL EMail Team,OU=Distribution Lists,OU=location,OU=_ADC,DC=mydomain,DC=com")
objuser.SetInfo
If err.number <> 0 Then
WriteErrorlog "Unable to modify " & strCN
End If
' ' Add (str)User to (str)Group
' Set objUser = GetObject("LDAP://"& strdn)
' Set objGroup = GetObject("LDAP://"& strOUGroup)
' objGroup.add(objUser.ADsPath)
' If err.number <> 0 Then
' WriteErrorLog "Unable to modify " & strCN
' End If
LSTROU = ("LDAP://" & StrOU)
WScript.Echo lstrou
'Rename Account
set objOU = getobject(LSTROU)
WScript.Echo (objuser.Adspath & " OU = " & STRou)
objOU.MoveHere objuser.Adspath,("CN=" & StrNewCN)
If err.number <> 0 Then
WriteErrorLog "Unable to modify " & strCN
End If
' Increment to next user.
intRow = intRow + 1
Loop
Wscript.Echo "Done"
objExcel.Quit
WScript.Quit
End Sub
Sub RenameAcct()
'String for date mmddyy
StrMonth = Month(Date)
StrYear = Right(Year(Date),2)
StrDay = Day(Date)
wscript.echo "start script"
strExcelPath = "i:\" & StrMonth & StrDay & StrYear & "_" & "work_Log" & ".xls"
' Open the Excel spreadsheet
Set objExcel = CreateObject("Excel.Application")
Set objSpread = objExcel.Workbooks.Open(strExcelPath)
intRow = 1
' Here is the 'DO...Loop' that cycles through the cells
' Note intRow, x must correspond to the column in strSheet
'This part marks the accounts for deletion.
Do Until objExcel.Cells(intRow,1).Value = ""
strCN = Trim(objExcel.Cells(intRow, 1).Value)
StrSAM = Trim(objExcel.Cells(intRow, 2).Value)
StrDN = Trim(objExcel.Cells(intRow, 3).Value)
StrUPN = Trim(objExcel.Cells(intRow, 13).Value)
StrDisplay = Trim(objExcel.Cells(intRow, 14).Value)
STRou = Trim(objExcel.Cells(intRow, 17).Value)
strougroup = "CN=GG_KBS_ES,OU=Groups,OU=KBS,DC=mydomain,DC=com"
StrNewCN = (StrMonth & "/" & StrDay & "/" & StrYear & " " & strdisplay)
WScript.Echo STRou
LSTROU = ("LDAP://" & StrOU)
'Rename Account
Set objOU = getobject(LSTROU)
objOU.MoveHere ("LDAP://" & StrDN),("CN=" & StrNewCN)
If err.number <> 0 Then
WriteErrorLog "Unable to modify " & strCN
End If
' Increment to next user.
intRow = intRow + 1
Loop
Wscript.Echo "Done"
objExcel.Quit
WScript.Quit
end Sub
'************************************************************************************************
' Error Logging
'************************************************************************************************
'write log information to file
sub WriteErrorLog(strLogErrorText)
strErrorFile = "I:\ErrorFile.txt"
ErrorLogCount = ErrorLogCount + 1
set fso2 = CreateObject("scripting.FileSystemObject")
Set fsoFile2 = fso2.OpenTextFile(strErrorFile, fsoForAppending, true)
fsoFile2.WriteLine strLogErrorText
fsoFile2.Close
end Sub
' Delete error log file before next pass
Sub DeleteErrorLog()
set objfso = CreateObject("Scripting.FileSystemObject")
If objFSO.FileExists(strErrorFile) Then
objFSO.DeleteFile(strErrorFile)
End If
End Sub