Option Explicit
On Error Resume Next

Dim objNetwork
Dim strHomeDrive, strHomePath, strUserName, strPassword, strProfile, strDomain, strSharedDrive, strSharedPath, strArchiveDrive, strArchivePath, bforce, bUpdateProfile, fso, WshShell, strDesktop, oShellLink

strUserName = InputBox("Enter your username.")
strPassword = InputBox("Enter your password.")
strDomain = "CORPORATE\"
strProfile = "false"
strHomeDrive = "H:"
strHomePath = "\\10.1.1.48\UserData$\" & strUserName
strSharedDrive = "I:"
strSharedPath = "\\10.1.1.137\SharedDocs"
strArchiveDrive = "W:"
strArchivePath = "\\10.1.1.137\archive$\" & strUserName
bforce = "true"
bUpdateProfile = "true"


Set objNetwork = WScript.CreateObject("WScript.Network") 
Set fso = CreateObject("Scripting.FileSystemObject")

If fso.DriveExists("H:") Then
	objNetwork.RemoveNetworkDrive strHomeDrive, bforce, bUpdateProfile
	If Err.Number <> 0 Then
		WScript.Echo "Unable to remove old mapped drive.  Please try again." & vbCrLf & "Techical Purposes Only  > Error: H - Unable to remove old mapped drive"
		WScript.Quit
	End If
	objNetwork.MapNetworkDrive strHomeDrive, strHomePath, strProfile, strDomain & strUserName, strPassword 
	If Err.Number <> 0 Then
		WScript.Echo "Check your username and password and try again." & vbCrLf & "Techical Purposes Only  > Error: H - Check your username and password and try again; removal"
		WScript.Quit
	End If
Else 
	objNetwork.MapNetworkDrive strHomeDrive, strHomePath, strProfile, strDomain & strUserName, strPassword
	If Err.Number <> 0 Then
		WScript.Echo "Check your username and password and try again." & vbCrLf & "Techical Purposes Only  > Error: H - Check username and password"
		WScript.Quit
	End If 
End If

If fso.DriveExists("I:") Then
  	objNetwork.RemoveNetworkDrive strSharedDrive, bforce, bUpdateProfile
	If Err.Number <> 0 Then
		WScript.Echo "Unable to remove old mapped drive.  Please try again." & vbCrLf & "Techical Purposes Only  > Error: I - Unable to remove old mapped drive"
		WScript.Quit
	End If
	objNetwork.MapNetworkDrive strSharedDrive, strSharedPath, strProfile, strDomain & strUserName, strPassword 
	If Err.Number <> 0 Then
		WScript.Echo "Check your username and password and try again." & vbCrLf & "Techical Purposes Only  > Error: I - Check your username and password and try again; removal"
		WScript.Quit
	End If
Else
	objNetwork.MapNetworkDrive strSharedDrive, strSharedPath, strProfile, strDomain & strUserName, strPassword 
	If Err.Number <> 0 Then
		WScript.Echo "Check your username and password and try again." & vbCrLf & "Techical Purposes Only  > Error: I - Check username and password"
		WScript.Quit
	End If 
End If

If fso.DriveExists("W:") Then
  	objNetwork.RemoveNetworkDrive strArchiveDrive, bforce, bUpdateProfile
	If Err.Number <> 0 Then
		WScript.Echo "Unable to remove old mapped drive.  Please try again." & vbCrLf & "Techical Purposes Only  > Error: W - Unable to remove old mapped drive"
		WScript.Quit
	End If
	objNetwork.MapNetworkDrive strArchiveDrive, strArchivePath, strProfile, strDomain & strUserName, strPassword 
	If Err.Number <> 0 Then
		WScript.Echo "Check your username and password and try again." & vbCrLf & "Techical Purposes Only  > Error: W - Check your username and password and try again; removal"
		WScript.Quit
	End If
Else
	objNetwork.MapNetworkDrive strArchiveDrive, strArchivePath, strProfile, strDomain & strUserName, strPassword 
	If Err.Number <> 0 Then
		WScript.Echo "Check your username and password and try again." & vbCrLf & "Techical Purposes Only  > Error: W - Check username and password"
		WScript.Quit
	End If 
End If
         
Set WshShell = WScript.CreateObject("WScript.Shell")

strDesktop = WshShell.SpecialFolders("Desktop")

Set oShellLink = WshShell.CreateShortcut(strDesktop & "\Shared Drive (I).lnk")
oShellLink.TargetPath = "I:\"
oShellLink.Description = "Shared Drive (I)"
oShellLink.Save
	If Err.Number <> 0 Then
		WScript.Echo "There was a problem creating the Shared Drive (I) Shortcut.  Please try again."
		Wscript.Quit
	End If
Set oShellLink = Nothing

Set oShellLink = WshShell.CreateShortcut(strDesktop & "\Home Drive (H).lnk")
oShellLink.TargetPath = "H:\"
oShellLink.Description = "Home Drive (H)"
oShellLink.Save
	If Err.Number <> 0 Then
		WScript.Echo "There was a problem creating the Home Drive (H) Shortcut.  Please try again."
		Wscript.Quit
	End If
Set oShellLink = Nothing

Set oShellLink = WshShell.CreateShortcut(strDesktop & "\Archive Drive (W).lnk")
oShellLink.TargetPath = "W:\"
oShellLink.Description = "Archive Drive (W)"
oShellLink.Save
	If Err.Number <> 0 Then
		WScript.Echo "There was a problem creating the Archive Drive (W) Shortcut.  Please try again."
		Wscript.Quit
	End If
Set oShellLink = Nothing

Wscript.Sleep 1000

WScript.Echo "I have finished mapping your drives." & vbCrLf & vbCrLf & "There is now a Shared Drive (I) shortcut, " & vbCrLf & "a Home Drive (H) shortcut, and an " & vbCrLf & "Archive Drive (W) shortcut on your desktop." & vbCrLf & vbCrLf & "Please click these shortcuts to access your " & vbCrLf & "Shared Drive (I), Home Drive (H), " & vbCrLf & "and Archive Drive (W)." & vbCrLf & vbCrLf & "You can now click OK and continue." & vbCrLf &vbCrLf & "Sincerely, your friendly IT Department." & vbCrLf &vbCrLf & "© 2009 Allan Farmer"
WScript.Quit