DriveMappingScript-Case.vbs

DriveMappingScript-Case.vbs

Option Explicit
ForceScriptEngine("cscript")
Const ForReading = 1
Const ForAppending = 8
Dim from_sv, to_sv, OldSharePath, DriveLetter, NewSharePath,Loop_Counter,WshNet,WS_NetworkDrives,shellApp
Dim objFSO,objFile,strComputer,intLenOldSharePath,intFromLen,intRightLen,strRightPath,WSHNetwork,strLogPath,strFileDate,objTextFile, strResult, strMatching
Set WshNet = CreateObject("WScript.Network")
strComputer = WshNet.ComputerName
Set shellApp = CreateObject("Shell.Application")
Set objFSO=CreateObject("Scripting.FileSystemObject")
strLogPath = "\\LoggingServer\PathToVeryOpenShare$\File_Server_Migration\" 'Log file output
strFileDate = Replace(FormatDateTime(Date(),2),"/","-")
from_sv = "SourceServerName" 'Source Server - e.g. server1.domain.com
to_sv = "\\FQDN Domain based DFS\Namespace\Folder" 'TARGET DRIVE e.g. \\domain.com\DFS\Files
from_sv = "\\" & lcase(from_sv)
to_sv = "\\" & lcase(to_sv)
Set WS_NetworkDrives = WshNet.EnumNetworkDrives
For Loop_Counter = 0 To WS_NetworkDrives.Count -1 Step 2
OldSharePath = lcase(WS_NetworkDrives(Loop_Counter + 1))
Wscript.Echo "OldSharePath: " & OldSharePath
strMatching = False
if LEFT(OldSharePath,len(from_sv)) = from_sv then
strMatching= True
Wscript.Echo "Matching Server: " & from_sv
strResult = strFileDate & "," & OldSharePath & "," & from_sv & ","
intLenOldSharePath = Len(OldSharePath)
intFromLen = len(from_sv)
intRightLen= intLenOldSharePath - intFromLen
strRightPath = Right(OldSharePath,intRightLen)
strRightPath = Replace(strRightPath,"$","")
strResult = strResult & strRightPath & ","
wscript.echo "strRightPath: " & strRightPath
End If
strRightPath = Lcase (strRightPath)
' The case statement provides a way of translating old share names that may not have been the same name as the folder, or where the path is longer - add as many as required, I have trimmed the production script a lot in order to provide a readable sample.
Select Case strRightPath
Case "\SHARENAME1" strRightPath = "\REALUNCNAMEOFPATH1" 'e.g. Case "\MyShare" strRightPath = "\MyImportantdocs"
Case "\SHARENAME2" strRightPath = "\REALUNCNAMEOFPATH2"
Case "\SHARENAME3" strRightPath = "\REALUNCNAMEOFPATH3\SubPath"
Case "\SHARENAME4" strRightPath = "\REALUNCNAMEOFPATH4"
Case "\SHARENAME5" strRightPath = "\REALUNCNAMEOFPATH5"
Case Else strRightPath = strRightPath
End Select
DriveLetter = ucase(WS_NetworkDrives(Loop_Counter))
Wscript.Echo "DriveLetter of matching share: " & DriveLetter
'We need to build the new share path using the new server name.
NewSharePath = to_sv
Wscript.Echo "NewSharePath: " & NewSharePath & strRightPath
NewSharePath = NewSharePath & strRightPath
If strMatching = True Then
strResult = strResult & DriveLetter & "," & NewSharePath & strRightPath
Set objTextFile = objFSO.OpenTextFile(strLogPath & strComputer & ".txt",8,True)
Mappings
objTextFile.Close
End If
Next
Set strMatching = Nothing
Set strResult = Nothing
Set objTextFile = Nothing
Set strFileDate = Nothing
Set strLogPath = Nothing
Set strRightPath = Nothing
Set intRightLen = Nothing
Set intFromLen = Nothing
Set intLenOldSharePath = Nothing
Set strComputer = Nothing
Set objFile = Nothing
Set WS_NetworkDrives = Nothing
Set WshNet = Nothing
Set from_sv = Nothing
Set to_sv = Nothing
Set OldSharePath = Nothing
Set DriveLetter = Nothing
Set NewSharePath = Nothing
Set Loop_Counter = Nothing
Set WSHNetwork = Nothing
Set shellApp = Nothing
Set objFSO = Nothing
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~Subs~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Sub Mappings
Wscript.Echo "##############################################################"
Wscript.echo "Starting Mappings"
If objFSO.FolderExists(NewSharePath) Then 'Check to see if the target exists
If DriveLetter="" Then
'wscript.echo "No drive letter assigned to mapping"
Else
WshNet.RemoveNetworkDrive DriveLetter, true, true ' Remove the current drive mapping
If Err.Number 0 then ' something went wrong, so remap the old drive letter and path
WshNet.MapNetworkDrive DriveLetter, OldSharePath, true
Wscript.Echo "You failed :( !!"
Wscript.Echo "==========================================================================="
else ' otherwise map the new drive letter and path
On error resume next
WshNet.MapNetworkDrive DriveLetter, NewSharePath, true
objTextFile.WriteLine strResult
On error goto 0
Wscript.Echo "Success!!"
Wscript.Echo "==========================================================================="
end if
End If
Else
'Wscript.Echo NewSharePath & " does not exist!"
'Wscript.Echo "==========================================================================="
Exit Sub
End If
End Sub
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Sub ForceScriptEngine(strScriptEng)
' Forces this script to be run under the desired scripting host.
' Valid arguments are "wscript" or "cscript".
' The command line arguments are passed on to the new call.
Dim arrArgs
Dim strArgs
For Each arrArgs In WScript.Arguments
strArgs = strArgs & " " & Chr(34) & arrArgs & Chr(34)
Next
If Lcase(Right(Wscript.FullName, 12)) = "\wscript.exe" Then
If Instr(1, Wscript.FullName, strScriptEng, 1) = 0 Then
CreateObject("Wscript.Shell").Run "cscript.exe //Nologo " & _
Chr(34) & Wscript.ScriptFullName & Chr(34) & strArgs
Wscript.Quit
End If
Else
If Instr(1, Wscript.FullName, strScriptEng, 1) = 0 Then
CreateObject("Wscript.Shell").Run "wscript.exe " & Chr(34) & _
Wscript.ScriptFullName & Chr(34) & strArgs
Wscript.Quit
End If
End If
End Sub
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++