Environment: Windows Server, Active Directory, Exchange, vb-script
Description: This script’s function is to do all Active Directory and Exchange steps for graduating students. The student accounts have been manually moved to a single Active Directory OU, from an approved list published by the Registrar. The Active Directory account and Exchange mailbox are logically removed from the system, eg removed from GAL, all group memberships removed, email address scrambled. This script can take several hours and can be run at off-hours.
Features:
- Results written to disk log file
- Trial no-update option
Code:
'=========================================================================
' FILE: UpdSeniors2007.vbs
' AUTHOR: Robert Lawson
' COMPANY: Soka University
' DATE: 25-May-2007
' COMMENT: Update/shutdown 2007 senior AD users
' Assumpitons
' 1. Run as Domain Admin
' 2. You have setup OU and moved seniors to this OU
' 4. Set to target Exchange mailbox
' 5. Must have installed "Exchange System Management Tools"on computer this script executes on. To
' do this you 1) Use Exchange CD, 2) Do Exchange installation
'=========================================================================
Option Explicit
' Variables
Dim fso, objFile, strRec, answer, logUpdate, objNetwork
Dim strOU, strFilter, strQuery, rs, objCommand, UserADsPath, objUser, objConnection
Dim strTargetHomeMDB_DN, strOriginalHomeMDB, objTargetHomeMDB, logSkipMoveMailBox
Dim proxyAddresses, proxyAddressesCount, i, email, emailOld, emailNew, objGroup, groupADsPath, objUserGroup
Dim dacl, ace, oSecurityDescriptor, sTrustee
' Constants
Const ADS_SCOPE_SUBTREE = 2
Const ADS_PROPERTY_DELETE = 4
Const ADS_PROPERTY_UPDATE = 2
Const ADS_PROPERTY_APPEND = 3
Const ADS_PROPERTY_CLEAR = 1
' Exchange AD Security
CONST ADS_ACETYPE_ACCESS_ALLOWED = 0
CONST ADS_ACEFLAG_INHERIT_ACE = 2
Const ForReading = 1
Const ForWriting = 2
Const consDisableAccount = 66050 ' AD user setting
Const consLogFile = "c:\temp\UpdSeniros2007.txt" ' File name to write data to
Const conScriptName = "UpdSeniors2007.vbs"
Const conADSelf = "NT AUTHORITY\SELF"
' ============================================================
' Log file setup
' ============================================================
Set fso = CreateObject("Scripting.FileSystemObject")
Set objFile = fso.OpenTextFile(consLogFile, ForWriting, True)
Set objNetwork = Wscript.CreateObject("Wscript.Network")
strRec = "Date = " & Date & " " & Time & _
", Script= " & conScriptName & _
", Computer = " & objNetwork.ComputerName & _
", User = " & objNetwork.UserName & "/" & objNetwork.UserDomain
Wscript.Echo strRec
objFile.WriteLine strRec & vbCr
' ============================================================
' Verify target mailbox exists
' ============================================================
strTargetHomeMDB_DN = "CN=ClassOf2007,CN=Students,CN=InformationStore,CN=server,CN=Servers,CN=First Administrative Group,CN=Administrative Groups,CN=uni,CN=Microsoft Exchange,CN=Services,CN=Configuration,DC=uni,DC=edu"
Set objTargetHomeMDB = CreateObject("CDOEXM.MailBoxStoreDB")
objTargetHomeMDB.DataSource.Open (strTargetHomeMDB_DN)
If Err.Number Then ErrorHandler (Err)
If objTargetHomeMDB.Status Then
strRec = "***ERROR: Target Store " & objTargetHomeMDB.Name & " is not mounted."
Wscript.Echo strRec
WScript.Quit (1)
else
strRec = "Target store verified: " & objTargetHomeMDB.Name
Wscript.Echo strRec
objFile.WriteLine strRec & vbCr
End If
' ============================================================
' Get users
' ============================================================
set objConnection=Createobject("ADODB.Connection")
set objCommand=CreateObject("ADODB.Command")
objConnection.Provider="ADSDSOObject"
objConnection.Open "Active Directory Provider"
Set objCommand.ActiveConnection = objConnection
strOU = "OU=UG Graduates 2007,OU=Students,OU=Location,DC=uni,DC=edu"
strFilter = "objectcategory='person' AND objectclass='user'"
strQuery = "SELECT ADsPath from 'LDAP://" & strOU & "' WHERE " & strFilter
Wscript.Echo strQuery
objFile.WriteLine strQuery & vbCr
objCommand.CommandText= strQuery
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
' ============================================================
' Proceed?
' ============================================================
strRec = "OU = " & strOU & vbCrLF & _
"FILTER = " & strFilter & vbCrLF & _
"TARGETMB = " & strTargetHomeMDB_DN
answer=MsgBox(strRec,vbYesNoCancel + vbInformation + vbDefaultButton2,"Update?")
if answer = vbOK or answer = vbYes then
logUpdate = TRUE
else
logUpdate = FALSE
end if
strRec = "UPDATE = " & logUpdate
Wscript.Echo strRec
objFile.WriteLine strRec & vbCr
' ============================================================
' Do Updates
' ============================================================
Set rs = objCommand.Execute
do while not rs.EOF
UserADsPath = rs.fields("ADsPath").value
Wscript.Echo UserADsPath
Set objUser = GetObject(UserADsPath)
strRec = "--Working on: " & objUser.sAMAccountname
Wscript.Echo strRec
objFile.WriteLine strRec & vbCr
' ------------------------------------------------------------
' Move Exchange mailbox
strOriginalHomeMDB = objUser.homeMDB
logSkipMoveMailBox = ((LCase(strOriginalHomeMDB) = LCase(strTargetHomeMDB_DN)) or _
Isnull(strOriginalHomeMDB))
Wscript.Echo "logSkipMoveMailBox = " & logSkipMoveMailBox
if logUpdate and NOT logSkipMoveMailBox then
On Error Resume Next
objUser.MoveMailbox "LDAP://" & strTargetHomeMDB_DN
If err.Number Then
strRec = "***ERROR: Unable to move from homeMDB " & strOriginalHomeMDB
Wscript.Echo "strOriginalHomeMDB = " & strOriginalHomeMDB
Wscript.Echo "strTargetHomeMDB_DN = " & strTargetHomeMDB_DN
strRec = "err = " & err.number & " " & err.Description
Wscript.Echo strRec
objFile.WriteLine strRec & vbCr
WScript.Quit (1)
else
strRec = "Moved mailbox from " & strOriginalHomeMDB & " to " & objUser.homeMDB
Wscript.Echo strRec
objFile.WriteLine strRec & vbCr
End If
end if
' ------------------------------------------------------------
' Hide from Exchange GAL
if logUpdate and not objUser.msExchHideFromAddressLists then
strRec = "Setting msExchHideFromAddressLists = TRUE"
Wscript.Echo strRec
objFile.WriteLine strRec & vbCr
objUser.Put "msExchHideFromAddressLists",TRUE
objUser.SetInfo
end if
' ------------------------------------------------------------
' Disable receiving email from outside
proxyAddresses = objUser.proxyAddresses
emailNew = ""
If Not IsNull(proxyAddresses) Then
proxyAddressesCount = UBound(proxyAddresses)
For i = 0 To proxyAddressesCount
email = proxyAddresses(i)
If Left(email,5) = "SMTP:" and instr(email,"XXX@") = 0 then
emailNew = email
emailOld = email
emailNew = replace(emailNew,"@","XXX@")
Wscript.Echo "Delete : " & email
Wscript.Echo "Adding: " & emailNew
proxyAddresses(i) = emailNew
end if
Next
if logUpdate and len(emailNew) > 0 then
strRec = "Changing " & emailOld & " to " & emailNew
Wscript.Echo strRec
objFile.WriteLine strRec & vbCr
objUser.putex ADS_PROPERTY_UPDATE, "proxyAddresses",array(emailNew)
objUser.SetInfo
end if
End if
' ------------------------------------------------------------
' Remove group memberships
For Each objGroup In objUser.Groups
groupADsPath = objGroup.ADsPath
Wscript.Echo groupADsPath
if logUpdate then
Set objUserGroup = GetObject(groupADsPath)
strRec = "Removing membership to : " & objUserGroup.sAMAccountname
Wscript.Echo strRec
objFile.WriteLine strRec & vbCr
objUserGroup.Remove(UserADsPath)
objUserGroup.Setinfo
end if
Next
' ------------------------------------------------------------
' Set MB rights (fixes problem in KB 555410)
Set oSecurityDescriptor = objUser.MailboxRights ' Get the Mailbox security descriptor (SD).
Set dacl = oSecurityDescriptor.DiscretionaryAcl 'Discretionary Access Control List (DACL)
Set Ace = CreateObject("AccessControlEntry")
if logUpdate then
strRec = "Fixing MB rights : " & objUser.sAMAccountname
Wscript.Echo strRec
objFile.WriteLine strRec & vbCr
Ace.AccessMask = 131079 ' SELF
Ace.AceType = ADS_ACETYPE_ACCESS_ALLOWED
Ace.AceFlags = ADS_ACEFLAG_INHERIT_ACE
Ace.Flags = 0 '
Ace.Trustee = conADSelf
dacl.AddAce Ace
oSecurityDescriptor.DiscretionaryAcl = dacl
objUser.MailboxRights = oSecurityDescriptor
objUser.SetInfo
end if
' ------------------------------------------------------------
' Set account to inactive
if logUpdate and objUser.userAccountControl <> consDisableAccount then
strRec = "Setting userAccountControl = " & consDisableAccount & "(disabled)"
Wscript.Echo strRec
objFile.WriteLine strRec & vbCr
objUser.Put "userAccountControl", consDisableAccount
objUser.SetInfo
end if
rs.movenext
Loop ' All users
' ============================================================
' The End
' ============================================================
strRec = "Date = " & Date & " " & Time & _
", Script= " & conScriptName & _
", Computer = " & objNetwork.ComputerName & _
", User = " & objNetwork.UserName & "/" & objNetwork.UserDomain
Wscript.Echo strRec
objFile.WriteLine strRec & vbCr
rs.Close
objFile.Close
objConnection.Close
