This script was requested by one of our help desk staff. The script gets the value of a specific property in an Active Directory user object and copies it over to the other property. In this instance, the script is using the value it finds in the "physicalDeliveryOfficeName" (Office field in ADUC) and puts that value into the "department" (Department field in ADUC). The script creates a log with all of the user names, date, and properties, before and after the change just in case something goes wrong.
Option Explicit
On Error Resume Next
Dim objUser, objChild, objConnection, objRootDSE, objItem
Dim WshShell, objFSO strRoot, strDNSDomain, strContainer
Dim strphysicalDeliveryOfficeName, strsAMAccountName
Dim strdepartmentAfter, strDirectory, strdepartmentBefore
Dim i, intLogFlag 'no log exists
i=1 intLogFlag = 0
Set WshShell = CreateObject("WScript.Shell")
'Set current directory to Desktop & display on page
strDirectory = WshShell.SpecialFolders("Desktop") & "\"
Set objRootDSE = GetObject("LDAP://RootDSE")
strDNSDomain = objRootDSE.Get("DefaultNamingContext")
strContainer = strContainer & strDNSDomain
'To do a subcontainer, add it after//ou=OUName, - include comma
Set strRoot =GetObject("LDAP://" & strDNSDomain )
'Start Logging
CreateLog()
'****************************************************************
For each objChild in strRoot
Select Case objChild.class
Case "organizationalUnit","container"
Call DATree
End Select
Next
Sub DATree()
For each objUser in objChild
If objUser.class="user" Then
strphysicalDeliveryOfficeName = objUser.physicalDeliveryOfficeName
strsAMAccountName = objUser.sAMAccountName
strdepartmentBefore = objUser.department
If strphysicalDeliveryOfficeName <> "" Then
objUser.Put "department", strphysicalDeliveryOfficeName
objUser.SetInfo
strdepartmentAfter = objUser.department
WriteLog(strphysicalDeliveryOfficeName), (strsAMAccountName), (strdepartmentBefore), (strdepartmentAfter)
i=i+1
End If
End if
next
End Sub
i = i -1
Wscript.Echo "Accounts = " & i
Wscript.Quit
'****************************************************************
Sub CreateLog()
On Error Resume
Next Dim objFile
Dim strFile, strText
'Create log file
strFile = "UserDepartmentLog_" & Month(Date()) & "_" & Day(Date()) & ".txt"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.CreateTextFile(strDirectory & strFile)
Set objFile = Nothing
'Write headers to the log file
strText = "User Name,Date,Office,Department Before, Department After"
Set objFile = objFSO.OpenTextFile(strDirectory & strFile, 8, True)
objFile.WriteLine(strText)
intLogFlag = 1
Set objFSO = Nothing
Set objFile = Nothing
End Sub
'****************************************************************
'Used to append the log for each computer the script is run against
Sub WriteLog(strOfficeName, strAccountName, strDeptBefore, strDeptAfter)
On Error Resume Next
Dim objFile, objTextFile
Dim strFile, strText
strFile = "UserDepartmentLog_" & Month(Date()) & "_" & Day(Date()) & ".txt"
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Check to see if the log exists
If intLogFlag = 1 Then
'Write to the log
strText = strAccountName & "," & Date() & "," & strOfficeName & "," & strDeptBefore & "," & strDeptAfter
Set objFile = objFSO.OpenTextFile(strDirectory & strFile, 8, True)
objFile.WriteLine(strText)
objFile.Close
'Reset strText for later use
strText = ""
Else 'If the log doesn't exist, create it
CreateLog()
'Reset strText for later use
strText = ""
End If
Set objTextFile = Nothing
Set objFile = Nothing
Set objFSO = Nothing
End Sub
