asked on

Multi- Network Drive Logon VB Script

Im new to VB Script, I have this log on script that Im working on. It works , except for Y:.
My question is can someone rewrite this so that the network drives use an array?
I that that would be the best way to do it, but dont yet understand how they work. If someone does it for me I think I can figure out how it works.

Option Explicit
Dim objNetwork, objShell
'
'Dim Remove Drive
Dim bForce, bUpdateProfile
'
'Dim drive 1
Dim strRemotePath1, strDriveLetter1, strNewName1
'
'Dim Drive 2
Dim strRemotePath2, strDriveLetter2, strNewName2
'
'Dim Drive 3
Dim strRemotePath3, strDriveLetter3, strNewName3
'
'Dim Drive 4
Dim strRemotePath4, strDriveLetter4, strNewName4
'Declare Remove Drive
bForce = "True"
err.number = vbempty
'
'Declare drive 1
strDriveLetter1 = "X:"
strRemotePath1 = "\\server1\itsoftware"
strNewName1 = "It Software"

' Declare drive 2
strDriveLetter2 = "G:"
strRemotePath2 = "\\server2\it"
strNewName2 = "IT Group"

' Declare drive 3
strDriveLetter3 = "z:"
strRemotePath3 = "\\server1\allstaffshare"
strNewName3 = "AllZooShare"
'
' Declare drive 4
strDriveLetter4 = "Y:"
strRemotePath4 = "\\server2\%username%$"
strNewName4 = "My Drive"
'
On Error Resume Next
' Section to map the network drive
'
'--------------------Main------------------------------------
Set objNetwork = CreateObject("WScript.Network")

' Removes strDriveLetter, with bForce, pUpdate Profile
'On Error Resume Next
objNetwork.RemoveNetworkDrive strDriveLetter1, _
bforce, bUpdateProfile

' Removes strDriveLetter, with bForce, pUpdate Profile
'On Error Resume Next
objNetwork.RemoveNetworkDrive strDriveLetter2, _
bforce, bUpdateProfile

' Removes strDriveLetter, with bForce, pUpdate Profile
'On Error Resume Next
objNetwork.RemoveNetworkDrive strDriveLetter3, _
bforce, bUpdateProfile
'
' Removes strDriveLetter, with bForce, pUpdate Profile
'On Error Resume Next
objNetwork.RemoveNetworkDrive strDriveLetter4, _
bforce, bUpdateProfile
'
objNetwork.MapNetworkDrive strDriveLetter1, strRemotePath1
objNetwork.MapNetworkDrive strDriveLetter2, strRemotePath2
objNetwork.MapNetworkDrive strDriveLetter3, strRemotePath3
objNetwork.MapNetworkDrive strDriveLetter4, strRemotePath4
'
' Section which actually (re)names the Mapped Drive
Set objShell = CreateObject("Shell.Application")
objShell.NameSpace(strDriveLetter1).Self.Name = strNewName1
objShell.NameSpace(strDriveLetter2).Self.Name = strNewName2
objShell.NameSpace(strDriveLetter3).Self.Name = strNewName3
objShell.NameSpace(strDriveLetter4).Self.Name = strNewName4

'
WScript.Quit

' End of script.

chandru_sol

Hi,

Can you try this version?

'Option Explicit
'Network Drive variables
Dim oNetwork
Dim sDriveF, sDriveT, sDriveU, sPathF, sPathT, sPathU
Dim wshShell, StrUsername,arrDrives, arrShares

Set wshShell = CreateObject("WScript.Shell")
strUsername = wshShell.ExpandEnvironmentStrings("%USERNAME%")

Wscript.echo StrUsername

'Local Drive variables
Dim oFSO

'Network drives and paths are defined
arrDrives = Array("X:", "G:", "z:","Y")
arrShares = Array("\\server1\itsoftware","\\server2\it","\\server1\allstaffshare","\\server2\" & StrUsername & "$")

If UBound(arrDrives) <> UBound(arrShares) Then
WScript.Quit
End If

'Below this line is network drive mapping takes place
On Error Resume Next
Set oNetwork = WScript.CreateObject("WScript.Network")
Set oFSO = WScript.CreateObject("Scripting.FileSystemObject")
For intCount = LBound(arrDrives) To UBound(arrDrives)
If oFSO.DriveExists(arrDrives(intCount)) Then
oNetwork.RemoveNetworkDrive arrDrives(intCount), True
End If

oNetwork.MapNetworkDrive arrDrives(intCount), arrShares(intCount), True
Next

RobSampson

Hey guys, here's my version:

'==============
Option Explicit
Dim objNetwork, objShell
'
'Dim Remove Drive
Dim bForce, bUpdateProfile
'
'Dim arrDrives for drives and shares
Dim arrDrives, strDriveDetails, strDrive, strShare, strRenameText
'
'Declare Remove Drive
bForce = "True"
bUpdateProfile = "True"
'

Set objNetwork = CreateObject("WScript.Network")
Set objShell = CreateObject("Shell.Application")

'Declare drive array, separated by the tilde (~) to it's share,
' and another to it's renamed text....
arrDrives = Array(_
      "X:~\\server1\itsoftware~IT Software", _
      "G:~\\server2\it~IT Group", _
      "Z:~\\server1\allstaffshare~AllZooShare", _
      "Y:~\\server2\" & objNetwork.UserName & "$~My Drive"
' Declare drive 3
strDriveLetter3 = "z:"
strRemotePath3 = "\\server1\allstaffshare"
strNewName3 = "AllZooShare"
'
' Declare drive 4
strDriveLetter4 = "Y:"
strRemotePath4 = "\\server2\%username%$"
strNewName4 = "My Drive"
'
On Error Resume Next
' Section to map the network drive
'
'--------------------Main------------------------------------

For Each strDriveDetails In arrDrives
      strDrive = Split(strDriveDetails, "~")(0)
      strShare = Split(strDriveDetails, "~")(1)
      strRenameText = Split(strDriveDetails, "~")(2)

      ' Removes strDriveLetter, with bForce, pUpdate Profile
      'On Error Resume Next
      objNetwork.RemoveNetworkDrive strDrive, bforce, bUpdateProfile

      ' Map the drive
      objNetwork.MapNetworkDrive strDrive, strShare, bUpdateProfile

      ' Section which actually (re)names the Mapped Drive
      objShell.NameSpace(strDrive).Self.Name = strRenameText
Next
'
WScript.Quit
'==============

Regards,

Rob.

pghzooit

ASKER

Ok, Thanks for the help, and we are almost there but its not working right. Maybe the script I started with is the best way, I dont know.
What Im trying to do is:
1. Remove any old shares that may be mapped to G:, X:,Y:,Z:.
Then
2. Map new shares to those drive letters.
And
3. Rename the mapped drives so I can lable them anything I want.

chandru_sol

Can you try this version which deletes the old drives and maps the new drives?

'Option Explicit
'Network Drive variables
Dim oNetwork
Dim sDriveF, sDriveT, sDriveU, sPathF, sPathT, sPathU
Dim wshShell, StrUsername,arrDrives, arrShares

Set wshShell = CreateObject("WScript.Shell")
Set WSHNetwork = CreateObject("WScript.Network")

'Grab the user name
UserString = WSHNetwork.UserName

Wscript.echo UserString

'Disconnect ALL mapped drives
Set clDrives = WshNetwork.EnumNetworkDrives
For i = 0 to clDrives.Count -1 Step 2
WSHNetwork.RemoveNetworkDrive clDrives.Item(i), True, True
Next

'Local Drive variables
Dim oFSO

'Network drives and paths are defined
arrDrives = Array("X:", "G:", "z:","Y:")
arrShares = Array("\\server01\" & UserString & "$","\\Server02\data","\\server03\CacheRoot\Data","\\Server04\data")

If UBound(arrDrives) <> UBound(arrShares) Then
WScript.Quit
End If

'Below this line is network drive mapping takes place
On Error Resume Next
Set oNetwork = WScript.CreateObject("WScript.Network")
Set oFSO = WScript.CreateObject("Scripting.FileSystemObject")
For intCount = LBound(arrDrives) To UBound(arrDrives)
If oFSO.DriveExists(arrDrives(intCount)) Then
oNetwork.RemoveNetworkDrive arrDrives(intCount), True
End If

oNetwork.MapNetworkDrive arrDrives(intCount), arrShares(intCount), True
Next

RobSampson

Hi pghzooit, this section of my version:

'==========
For Each strDriveDetails In arrDrives
strDrive = Split(strDriveDetails, "~")(0)
strShare = Split(strDriveDetails, "~")(1)
strRenameText = Split(strDriveDetails, "~")(2)

' Removes strDriveLetter, with bForce, pUpdate Profile
'On Error Resume Next
objNetwork.RemoveNetworkDrive strDrive, bforce, bUpdateProfile

' Map the drive
objNetwork.MapNetworkDrive strDrive, strShare, bUpdateProfile

' Section which actually (re)names the Mapped Drive
objShell.NameSpace(strDrive).Self.Name = strRenameText
Next
'==========

should remove those drives specified in the array, then map the drive again, and rename it.

That should cover the three points you have mentioned.

If you are receiving an error, please let us know what that error, and on which line it occurs. If you are not receiving error, please check whether you have an "On Error Resume Next" statement in your code, in which case, comment it out, and try again.

Regards,

Rob.

RobSampson

Actually, scrap that.....I just realised there was a bit of unneccesary code in my version, try this one, where I have commented out any On Error Resume Next's....

'==============
Option Explicit
Dim objNetwork, objShell
'
'Dim Remove Drive
Dim bForce, bUpdateProfile
'
'Dim arrDrives for drives and shares
Dim arrDrives, strDriveDetails, strDrive, strShare, strRenameText
'
'Declare Remove Drive
bForce = "True"
bUpdateProfile = "True"
'

Set objNetwork = CreateObject("WScript.Network")
Set objShell = CreateObject("Shell.Application")

'Declare drive array, separated by the tilde (~) to it's share,
' and another to it's renamed text....
arrDrives = Array(_
"X:~\\server1\itsoftware~IT Software", _
"G:~\\server2\it~IT Group", _
"Z:~\\server1\allstaffshare~AllZooShare", _
"Y:~\\server2\" & objNetwork.UserName & "$~My Drive"

'
'On Error Resume Next
' Section to map the network drive
'
'--------------------Main------------------------------------

For Each strDriveDetails In arrDrives
strDrive = Split(strDriveDetails, "~")(0)
strShare = Split(strDriveDetails, "~")(1)
strRenameText = Split(strDriveDetails, "~")(2)

' Removes strDriveLetter, with bForce, pUpdate Profile
'On Error Resume Next
objNetwork.RemoveNetworkDrive strDrive, bforce, bUpdateProfile

' Map the drive
objNetwork.MapNetworkDrive strDrive, strShare, bUpdateProfile

' Section which actually (re)names the Mapped Drive
objShell.NameSpace(strDrive).Self.Name = strRenameText
Next
'
WScript.Quit
'==============

Regards,

Rob.

pghzooit

ASKER

Im still getting errors,
Unfortunetly Im not catching on yet to what your doing. I think the problem may be the y drive.
It says path not found.

Also, the part with the remove drive; I am in the process of changing servers so thats why I need to remove the old drives.

If you have any more questions ask please.

chandru_sol

Can i know which script you tried?

pghzooit

ASKER

all of them , but I was refering to the last one

chandru_sol

Can you try this version and post the results?

'Option Explicit
'Network Drive variables
Dim oNetwork
Dim sDriveF, sDriveT, sDriveU, sPathF, sPathT, sPathU
Dim wshShell, StrUsername,arrDrives, arrShares

Set wshShell = CreateObject("WScript.Shell")
Set WSHNetwork = CreateObject("WScript.Network")

'Grab the user name
UserString = WSHNetwork.UserName

Wscript.echo UserString

'Disconnect any drive mappings as needed.
WSHNetwork.RemoveNetworkDrive "X:", True, True
WSHNetwork.RemoveNetworkDrive "G:", True, True
WSHNetwork.RemoveNetworkDrive "Z:", True, True
WSHNetwork.RemoveNetworkDrive "Y:", True, True

'Disconnect ALL mapped drives
'Set clDrives = WshNetwork.EnumNetworkDrives
'For i = 0 to clDrives.Count -1 Step 2
' WSHNetwork.RemoveNetworkDrive clDrives.Item(i), True, True
'Next

'Local Drive variables
Dim oFSO

'Network drives and paths are defined
arrDrives = Array("X:", "G:", "Z:","Y:")
arrShares = Array("\\server01\" & UserString & "$","\\Server02\data","\\server03\CacheRoot\Data","\\Server04\data")

If UBound(arrDrives) <> UBound(arrShares) Then
WScript.Quit
End If

'Below this line is network drive mapping takes place
On Error Resume Next
Set oNetwork = WScript.CreateObject("WScript.Network")
Set oFSO = WScript.CreateObject("Scripting.FileSystemObject")
For intCount = LBound(arrDrives) To UBound(arrDrives)
If oFSO.DriveExists(arrDrives(intCount)) Then
oNetwork.RemoveNetworkDrive arrDrives(intCount), True
End If

oNetwork.MapNetworkDrive arrDrives(intCount), arrShares(intCount), True
Next

RobSampson

Hi, try this version, which will give you status output as it goes. Then, copy that text, and paste it here, and we'll see where the error is.....you be able to see if the Y drive path is trying to point to the right place....

'==============
Option Explicit

' CHANGE THE %comspec& /k TO %comspec% /c BELOW TO MAKE THE PROMPT DISAPPEAR WHEN SCRIPT HAS FINISHED
Dim strPath, strCommand, objShell
If LCase(Right(Wscript.FullName, 11)) = "wscript.exe" Then
strPath = Wscript.ScriptFullName
strCommand = "%comspec% /k cscript """ & strPath & """"
Set objShell = CreateObject("Wscript.Shell")
objShell.Run(strCommand), 1, True
Wscript.Quit
End If

Dim objNetwork
'
'Dim Remove Drive
Dim bForce, bUpdateProfile
'
'Dim arrDrives for drives and shares
Dim arrDrives, strDriveDetails, strDrive, strShare, strRenameText
'
'Declare Remove Drive
bForce = "True"
bUpdateProfile = "True"
'

Set objNetwork = CreateObject("WScript.Network")
Set objShell = CreateObject("Shell.Application")

'Declare drive array, separated by the tilde (~) to it's share,
' and another to it's renamed text....
arrDrives = Array(_
"X:~\\server1\itsoftware~IT Software", _
"G:~\\server2\it~IT Group", _
"Z:~\\server1\allstaffshare~AllZooShare", _
"Y:~\\server2\" & objNetwork.UserName & "$~My Drive" _
)

'
On Error Resume Next
' Section to map the network drive
'
'--------------------Main------------------------------------

For Each strDriveDetails In arrDrives
      strDrive = Split(strDriveDetails, "~")(0)
      strShare = Split(strDriveDetails, "~")(1)
      strRenameText = Split(strDriveDetails, "~")(2)

      ' Removes strDriveLetter, with bForce, pUpdate Profile
      'On Error Resume Next

      WScript.Echo "Attempting to remove connection to " & strDrive
      'objNetwork.RemoveNetworkDrive strDrive, bforce, bUpdateProfile
      If Err.Number <> 0 Then
            WScript.Echo "Error removing " & strDrive & " - " & Err.Number & ": " & Err.Description
            Err.Clear
      Else
            WScript.Echo strDrive & " removed"
      End If

      ' Map the drive
      WScript.Echo "Attempting to map " & strDrive & " to " & strShare
      objNetwork.MapNetworkDrive strDrive, strShare, bUpdateProfile
      If Err.Number <> 0 Then
            WScript.Echo "Error mapping " & strDrive & " - " & Err.Number & ": " & Err.Description
            Err.Clear
      Else
            WScript.Echo strDrive & " was successfully mapped."
      End If

      ' Section which actually (re)names the Mapped Drive
      WScript.Echo "Attempting to rename " & strDrive & " to " & strRenameText
      objShell.NameSpace(strDrive).Self.Name = strRenameText
      If Err.Number <> 0 Then
            WScript.Echo "Error renaming " & strDrive & " - " & Err.Number & ": " & Err.Description
            Err.Clear
      Else
            WScript.Echo strDrive & " was successfully renamed."
      End If
Next
'
WScript.Quit
'==============

Regards,

Rob.

pghzooit

ASKER

Rob,
Microsoft (R) Windows Script Host Version 5.7
Copyright (C) Microsoft Corporation. All rights reserved.

Attempting to remove connection to X:
X: removed
Attempting to map X: to \\server1\itsoftware
Error mapping X: - -2147023694: The local device name has a remembered connectio
n to another network resource.

Attempting to rename X: to IT Software
X: was successfully renamed.
Attempting to remove connection to G:
G: removed
Attempting to map G: to \\server2\it
G: was successfully mapped.
Attempting to rename G: to IT Group
G: was successfully renamed.
Attempting to remove connection to Z:
Z: removed
Attempting to map Z: to \\server1\allstaffshare
Error mapping Z: - -2147024811: The local device name is already in use.

Attempting to rename Z: to AllZooShare
Z: was successfully renamed.
Attempting to remove connection to Y:
Y: removed
Attempting to map Y: to \\server2\jdoe$
Error mapping Y: - -2147024811: The local device name is already in use.

Attempting to rename Y: to My Drive
Y: was successfully renamed.

C:\Users\jdoe\Desktop\VB scripts>

RobSampson

Oh no, I left this line commented out:
'objNetwork.RemoveNetworkDrive strDrive, bforce, bUpdateProfile

Please remove the apostophe from that line and run again.....sorry!

Also, does the path to the Y drive look correct for your environment?

Regards,

Rob.

pghzooit

ASKER

Microsoft (R) Windows Script Host Version 5.7
Copyright (C) Microsoft Corporation. All rights reserved.

Attempting to remove connection to X:
Error removing X: - -2147022646: This network connection does not exist.

Attempting to map X: to \\server1\itsoftware
X: was successfully mapped.
Attempting to rename X: to IT Software
X: was successfully renamed.
Attempting to remove connection to G:
Error removing G: - -2147022646: This network connection does not exist.

Attempting to map G: to \\server2\it
Error mapping G: - -2147024843: The network path was not found.

Attempting to rename G: to IT Group
Error renaming G: - 424: Object required
Attempting to remove connection to Z:
Z: removed
Attempting to map Z: to \\server1\allstaffshare
Error mapping Z: - -2147024843: The network path was not found.

Attempting to rename Z: to AllZooShare
Error renaming Z: - 424: Object required
Attempting to remove connection to Y:
Error removing Y: - -2147022646: This network connection does not exist.

Attempting to map Y: to \\server2\jdoe$
Error mapping Y: - -2147024843: The network path was not found.

Attempting to rename Y: to My Drive
Error renaming Y: - 424: Object required

pghzooit

ASKER

Hey EE guys Im leaving on my honeymoon on the 16th, I will award points, Please dont close this if not resolved!!!! I will be back on the 1st.

chandru_sol

Hi Pghzooit,

Can we try know to close this before you go?

ASKER CERTIFIED SOLUTION

RobSampson

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

chandru_sol

Hi Rob,

Congrats.. and advance wishes for a very happy married life

Hi Pghzooit,

Congratulations for a happy married life and enjoy your honeymoon

RobSampson

Thanks Chandru.... ;-)

pghzooit

ASKER

Im back

pghzooit

ASKER

Thanks Rob,
sorry it took so long,
all i had to do is run the script twice in a rowfor it to work.

RobSampson

Great. Thanks. I hope you had a nice honeymoon! Mine's only three and a half weeks away now! I can't wait, I so need a holiday!

Regards,

Rob.