We help IT Professionals succeed at work.

Multi- Network Drive Logon  VB Script

pghzooit
pghzooit asked
on
1,639 Views
Last Modified: 2009-12-16
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.
Comment
Watch Question

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
CERTIFIED EXPERT
Most Valuable Expert 2012
Top Expert 2014

Commented:
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.

Author

Commented:
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.

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

CERTIFIED EXPERT
Most Valuable Expert 2012
Top Expert 2014

Commented:
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.
CERTIFIED EXPERT
Most Valuable Expert 2012
Top Expert 2014

Commented:
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.

Author

Commented:
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.
Can i know which script you tried?

Author

Commented:
all of them , but I was refering to the last one
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
CERTIFIED EXPERT
Most Valuable Expert 2012
Top Expert 2014

Commented:
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.

Author

Commented:

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>
CERTIFIED EXPERT
Most Valuable Expert 2012
Top Expert 2014

Commented:
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.

Author

Commented:
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

Author

Commented:
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.
Hi Pghzooit,

Can we try know to close this before you go?
CERTIFIED EXPERT
Most Valuable Expert 2012
Top Expert 2014
Commented:
Unlock this solution and get a sample of our free trial.
(No credit card required)
UNLOCK SOLUTION
Hi Rob,

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

Hi Pghzooit,

Congratulations for a happy married life and enjoy your honeymoon
CERTIFIED EXPERT
Most Valuable Expert 2012
Top Expert 2014

Commented:
Thanks Chandru....   ;-)

Author

Commented:
Im back

Author

Commented:
Thanks Rob,
sorry it took so long,
all i had to do is run the script twice in a rowfor it to work.
CERTIFIED EXPERT
Most Valuable Expert 2012
Top Expert 2014

Commented:
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.
Unlock the solution to this question.
Thanks for using Experts Exchange.

Please provide your email to receive a sample view!

*This site is protected by reCAPTCHA and the Google Privacy Policy and Terms of Service apply.

OR

Please enter a first name

Please enter a last name

8+ characters (letters, numbers, and a symbol)

By clicking, you agree to the Terms of Use and Privacy Policy.