• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 1504
  • Last Modified:

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.
0
pghzooit
Asked:
pghzooit
  • 8
  • 8
  • 6
1 Solution
 
chandru_solCommented:
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
0
 
RobSampsonCommented:
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.
0
 
pghzooitAuthor 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.
0
Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.

 
chandru_solCommented:

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

0
 
RobSampsonCommented:
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.
0
 
RobSampsonCommented:
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.
0
 
pghzooitAuthor 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.
0
 
chandru_solCommented:
Can i know which script you tried?
0
 
pghzooitAuthor Commented:
all of them , but I was refering to the last one
0
 
chandru_solCommented:
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
0
 
RobSampsonCommented:
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.
0
 
pghzooitAuthor 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>
0
 
RobSampsonCommented:
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.
0
 
pghzooitAuthor 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
0
 
pghzooitAuthor 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.
0
 
chandru_solCommented:
Hi Pghzooit,

Can we try know to close this before you go?
0
 
RobSampsonCommented:
Hi pghzooit,

Hey, congratulations on getting married, and happy honeymooning!  I'll be doing the same in six weeks!

Back to the question, by the output you're getting, it's pretty easy to see what's not working...

"Attempting to remove connection" errors are fine, that just means the map doesn't exist first.

Attempting to map G: to \\server2\it
and
Attempting to map Z: to \\server1\allstaffshare
and
Attempting to map Y: to \\server2\jdoe$

all result in
Error mapping Z: - -2147024843: The network path was not found.

which means exactly that, the shares of
\\server2\it
\\server1\allstaffshare
\\server2\jdoe$

do not exist, or do not have the correct NTFS permissions on them.

Please make that this array the correct details:
arrDrives = Array(_
      "X:~\\server1\itsoftware~IT Software", _
      "G:~\\server2\it~IT Group", _
      "Z:~\\server1\allstaffshare~AllZooShare", _
      "Y:~\\server2\" & objNetwork.UserName & "$~My Drive" _
      )

of which the parameters are:
"<DRIVE>" plus tilde plus "<\\SERVER\SHARE>" plus tilde plus "<NEWNAME>"
so above, the Z drive is Z: plus tilde plus \\server1\allstaffshare plus tilde plus AllZooShare

Regards,

Rob.
0
 
chandru_solCommented:
Hi Rob,

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

Hi Pghzooit,

Congratulations for a happy married life and enjoy your honeymoon
0
 
RobSampsonCommented:
Thanks Chandru....   ;-)
0
 
pghzooitAuthor Commented:
Im back
0
 
pghzooitAuthor Commented:
Thanks Rob,
sorry it took so long,
all i had to do is run the script twice in a rowfor it to work.
0
 
RobSampsonCommented:
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.
0

Featured Post

Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

  • 8
  • 8
  • 6
Tackle projects and never again get stuck behind a technical roadblock.
Join Now