Problem Users home folders mapped to old servers that do
not exist any more or you need to find out where all the
users home folders are pointed.
Here is a useful tool for replacing the Users home folder
in Active Directory from their old server to their new
server.
User Rights required for creating the CSV, just enter bogus
search request.
Old :\\borgserver1\SevenOfNine\
New :\\Reallylongservername\users\
Domain Admin rights required to change anything in AD
David
'----------------------------------------------------------------------------------------------------
'search and replace Active Directory Users Home folders
'
'Written By David Cohen
'
' Version 0.8
'
' outputs CSV File with date in name with users current and new home folder settings
' Ask user for old home folder \\OldServer\Share\
' Ask user for New home folder \\NewServer\Share\
' scan users with home folders and then replaces old with new
'
Option Explicit
Dim strcounter, strusercounter
Dim strFolder,strCommand,strProgramName
Dim strOutput, strOutputfile
Dim objFSO, objConnection, objCommand, objRecordSet
Dim objRootDSE, strDomain
Dim strOldHomeFolder, strNewHomeFolder
Dim strBackupName, strMessageReply
Dim changedusers
Const ForReading = 1
Const ForWriting = 2
Const ForAppending = 8
Const ADS_SCOPE_SUBTREE = 2
'---------------------------------------------------------------------------------------
'initialize objects
Set objFSO = createObject("scripting.filesystemobject")
Set objRootDSE = GetObject("LDAP://rootDSE")
strDomain = objRootDSE.Get("defaultNamingContext")
'-----------------------------------------------------------------------------------------
Call ScriptPath(strFolder,strCommand,strProgramName)
strcounter = 0
strusercounter = 0
changedusers = 0
'create unique filename by date
strBackupName = GetTodaysDateString()
'open output file
strOutput = inputbox("Please enter Output file name", "Output File", strfolder & strBackupName & "_" & strProgramName & ".csv")
If strOutput = "" Then
wscript.quit
End If
'add extension if required
If right(stroutput,4)<>".csv" Then
stroutput = stroutput + ".csv"
End If
'delete file if it exist
If objFSO.FileExists(strOutputFile) Then
objFSO.DeleteFile(strOutputFile)
End If
'open output file
Set strOutputFile = objfso.opentextfile(strOutput, ForWriting, True)
'write csv header in output file
strOutputFile.write ("sAMAccountName" & ",")
strOutputFile.write ("Server Name" & ",")
strOutputFile.write ("Old Home Directory" & ",")
strOutputFile.write ("User Folder Name" & ",")
strOutputFile.write ("New Home Directory" & ",")
strOutputFile.write ("Distinguished Name" & ",")
strOutputFile.writeline()
strOutputFile.close
'get old home folder folder path
strOldHomeFolder = inputbox("Please enter old home folder path", "Old Home Folder Path", "\\ServerA\share")
If strOldHomeFolder = "" Then
wscript.quit
End If
'force porgram to only search for servers
If left(strOldHomeFolder,2) <> "\\" Then
wscript.echo "Old home folder path must be in format of \\ServerA\share"
wscript.quit
End If
' get new home folder folder path
strNewHomeFolder = inputbox("Please enter new home folder path", "New Home Folder Path", "\\ServerB\share")
If strNewHomeFolder = "" Then
wscript.quit
End If
'force porgram to only search for servers
If left(strNewHomeFolder,2) <> "\\" Then
wscript.echo "New home folder path must be in format of \\ServerB\share"
wscript.quit
End If
'display user input with chance to exit
strMessageReply = msgbox("Searching User Home folders for " & strOldHomeFolder & vbCrlf _
& " and Replacing with new folder " & strNewHomeFolder,vbYesno,"Continue with search ?")
If strMessageReply = 7 Then
wscript.quit
End If
'open connection to AD
Set objConnection = CreateObject("ADODB.Connection")
Set objCommand = CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
Set objCommand.ActiveConnection = objConnection
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
objCommand.CommandText = _
"SELECT homedirectory,distinguishedName,sAMAccountName FROM 'LDAP://" & strDomain & "' WHERE objectCategory='user'"
Set objRecordSet = objCommand.Execute
objRecordSet.MoveFirst
'open output file
Set strOutputFile = objfso.opentextfile(strOutput, ForAppending, True)
'process users
Do Until objRecordSet.EOF
'if user has no home directory skip it
If objRecordSet.Fields("homedirectory").Value <> "" Then
listUsersoldHomeFolders()
listUsersnewHomeFolders()
strOutputFile.writeline()
strcounter = strcounter + 1
End If
objRecordSet.MoveNext
strusercounter = strusercounter + 1
Loop
'close output file
strOutputFile.close
'close object
Set objfso = Nothing
msgbox("Processed " & strcounter & " Users with home directories and " & changedusers & " Users were Changed" _
& vbCrlf & vbCrlf & "Prgram Complete output file Is located at" & vbCrlf & vbCrlf & stroutput)
'------------------------------------ Functions and Sub Routines below --------------------
'*****************************************************
'This function returns the path from which the script was called
'Call ScriptPath(strFolder,strCommand,strProgramName)
'wscript.echo "Called from folder : -> " & strFolder & vbCrlf & "Calling Program Line : -> " & strCommand & vbCrlf _
'& "Calling Program Name : -> " & strProgramName & vbCrlf
'wscript.quit
Function ScriptPath(callingfolder, callingcommandline, callingprogramname)
ScriptPath=Left(Wscript.scriptfullname,Instr(1,WScript.ScriptFullName,wscript.scriptname,1)-1)
callingfolder=scriptpath
callingcommandline=wscript.scriptfullname
callingprogramname=left(wscript.scriptname,len(wscript.scriptname)-4)
End Function
'********************************************************
' returns todays date formated as YYYYMMDD such as 20080328 for 28 MAR 2008
Function GetTodaysDateString()
Dim dtmThisYear, dtmThisMonth, dtmThisDay, strbackupname
'create unique filename by date
dtmThisYear = Year(Date)
If Month(Date)<10 Then
dtmThisMonth = "0" & Month(Date)
Else
dtmThisMonth = Month(Date)
End If
If Day(Date)<10 Then
dtmThisDay = "0" & Day(Date)
Else
dtmThisDay = Day(Date)
End If
GetTodaysDateString = dtmThisYear & dtmThisMonth & dtmThisDay
End Function
'************************************************************
' list users home folders in csv file
Function listUsersoldHomeFolders()
strOutputFile.write (chr(34) & objRecordSet.Fields("sAMAccountName").Value) & chr(34) & ","
strOutputFile.write (chr(34) & getservername(objRecordSet.Fields("homedirectory").Value)) & chr(34) & ","
strOutputFile.write (chr(34) & objRecordSet.Fields("homedirectory").Value) & chr(34) & ","
End Function
'****************************************************************
'===================================================================================
'Function getservername(strDirectoryPath)
'\\ServerA\folder\104bulletin$ returns ServerA
'
Function getservername(strDirectoryPath)
Dim counter, ss, Servername
ss=""
'parse forwards to find first \\ and then \ everthing in between is the server name
If left(strDirectoryPath,2) = "\\" then
For counter = 3 To len(strDirectoryPath)
ss = mid(strDirectoryPath,3,counter-2)
If right(ss,1) = "\" then
getservername = left(ss,counter-3)
Exit Function
End If
Next
Else
getservername = "No Server Name Found"
End If
End Function
'*************************************************************************
' list users home folders in csv file
Function listUsersnewHomeFolders()
Dim objUser
strOutputFile.write (chr(34) & getfoldername(objRecordSet.Fields("homedirectory").Value)) & chr(34) & ","
If instr(lcase(objRecordSet.Fields("homedirectory").Value), lcase(strOldHomeFolder))>0 Then
' connect to user
Set objUser = GetObject("LDAP://" & objRecordSet.Fields("distinguishedName").Value)
On Error Resume Next
objUser.Put "homedirectory",strNewHomeFolder & getfoldername(objRecordSet.Fields("homedirectory").Value)
objUser.SetInfo
changedusers = changedusers + 1
strOutputFile.write (chr(34) & strNewHomeFolder & getfoldername(objRecordSet.Fields("homedirectory").Value)) & chr(34) & ","
Else
strOutputFile.write (chr(34) & " ") & chr(34) & ","
End If
strOutputFile.write (chr(34) & objRecordSet.Fields("distinguishedName").Value) & chr(34) & ","
End Function
'***********************************************************************
'=========================================================================================
'takes users home folder path and returns user folder name (Aka name of folder)
'\\ServerA\home folders\104bulletin$ returns 104bulletin$
'
Function getfoldername(strDirectoryPath)
Dim counter, ss, foldername
ss=""
'parse backwards to find first \ everthing to the right is folder name
For counter = len(strDirectoryPath) To 1 Step -1
ss = right(strDirectoryPath,len(strDirectoryPath)+1-counter)
If left(ss,1) = "\" then
foldername = right(strDirectoryPath,len(strDirectoryPath)-counter)
getfoldername = foldername
Exit Function
End If
Next
End Function
'eof