Map Network Drives with VBScript

When setting up that Access database on a local area network, you'll likely need to map network drives on each end user's PC. This means you'll be creating a psuedo-drive "Z:" or whatnot, which opens a folder on the server where your Access application back-end resides.

As new computers are added to the network, you'll need to map the network drives on the new computers. This process can be eased by running a VBScript to automatically do the drive mapping. Below is an example script that I use to do this. You can modify the "Actions" to add or remove mapped network drives, in case you have multiple drives mapped, or need to do some mapping clean up.

Just save this code in a file with a .vbs extension, modify it for your needs, then double-click it from Windows Explorer to run it.

' Map network drives 

' Usage
'    Set the size of the ADrive, ARemoteShare, and AAction arrays to
'    be the number of drive mapping actions you want to take. Modify
'    the "Actions" in the "Fill Actions Array" section below, save, 
'    then double-click on this file from Windows Explorer to run it.
'
' "Actions" can be "Remove" (removes/disconnects a mapped network 
' drive), or "Add" (adds a mapped network drive, replacing whatever 
' mapping exists for the same drive letter).
'
' For multiple "Actions", modify the array sizes below, then fill
' the array entries as shown in the "Fill Actions Array" section below.
'
' This script will remove any existing drive map to the same drive letter
' including persistent or remembered connections (Q303209)
'
' from: http://ss64.com/vb/syntax-drivemap.html
' modified by Peter De Baets 12/28/2011

Option Explicit
Dim objNetwork, objDrives, objReg, i, objDrive, fileSys
Dim strReplaceDrive, strLocalDrive, strRemoteShare, strShareConnected, strMessage
Dim bolFoundExisting, bolFoundRemembered
Const HKCU = &H80000001
Dim J
'******************************************
'* Set the size of these arrays to the number
'* of drive mapping actions you want to take.
'*
Dim ADrive(2)
Dim ARemoteShare(2) 
Dim AAction(2)
'*
'****************************************** 


'******************************************
'* Fill Actions Array 
'* (make your changes here)
'*
' Example
'ADrive(1) = "X:"
'ARemoteShare(1) = "\\Servername\Share"
'AAction(1) = "Add"

' Action #1
ADrive(1) = "X:"
ARemoteShare(1) = "\\MyServer\MyShare"
AAction(1) = "Remove"

' Action #2
ADrive(2) = "Z:"
ARemoteShare(2) = "\\MyServer\MyShare"
AAction(2) = "Add"
'*
'******************************************


Set filesys = CreateObject("Scripting.FileSystemObject") 
for j = 1 to ubound(AAction)
  ' Check parameters passed make sense
  If Right(ADrive(j), 1) <> ":" OR Left(ARemoteShare(j), 2) <> "\\" Then
    wscript.echo "INvalid Action #" & j & " //NoLogo"
    WScript.Quit(1)
  End If
  if AAction(j) = "Add" then
    wscript.echo " - Mapping: " + ADrive(j) + " to " + ARemoteShare(j)
  Else
    wscript.echo " - Disconnecting: " + ADrive(j) + " from " + ARemoteShare(j)
  End If
  Set objNetwork = WScript.CreateObject("WScript.Network")
  ' Loop through the network drive connections and disconnect any that match strLocalDrive
  bolFoundExisting = False
  Set objDrives = objNetwork.EnumNetworkDrives
  If objDrives.Count > 0 Then
    For i = 0 To objDrives.Count-1 Step 2
      If objDrives.Item(i) = ADrive(j) Then
     if AAction(j) = "Remove" Then
    set objDrive = fileSys.GetDrive(objDrives.Item(i))
       if objDrive.ShareName = ARemoteShare(j) then
            strShareConnected = objDrives.Item(i+1)
            objNetwork.RemoveNetworkDrive ADrive(j), True, True
            i=objDrives.Count-1
            bolFoundExisting = True
    Else
      wscript.echo " - Drive " + ADrive(j) + " connected to " + ARemoteShare(j) + " not found. Continuing..."
    End if
  Else
       'wscript.echo "  sharename=" + objDrive.ShareName
          strShareConnected = objDrives.Item(i+1)
          objNetwork.RemoveNetworkDrive ADrive(j), True, True
          i=objDrives.Count-1
          bolFoundExisting = True
  End if
      End If
    Next
  End If

  ' If there's a remembered location (persistent mapping) delete the associated HKCU registry key
  If bolFoundExisting <> True Then
    Set objReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
    objReg.GetStringValue HKCU, "Network\" & Left(ADrive(j), 1), "RemotePath", strShareConnected
    If strShareConnected <> "" Then
      objReg.DeleteKey HKCU, "Network\" & Left(ADrive(j), 1)
      Set objReg = Nothing
      bolFoundRemembered = True
    End If
  End If

  if AAction(j) = "Add" then
    'Now actually do the drive map (persistent)
    Err.Clear
    On Error Resume Next
    objNetwork.MapNetworkDrive ADrive(j), ARemoteShare(j), True
  End If
Next 

'Error traps
If Err <> 0 Then
  Select Case Err.Number
    Case -2147023694
      'Persistent connection so try a second time
      On Error Goto 0
      objNetwork.RemoveNetworkDrive ADrive(j), True, True
      objNetwork.MapNetworkDrive ADrive(j), ARemoteShare(j), True
      WScript.Echo "Second attempt to " & AAction(j) & " map drive " & ADrive(j) & " to/from " & ARemoteShare(j)
    Case Else
      On Error GoTo 0
      WScript.Echo " - ERROR: Failed to " & AAction(j) & " map drive " & ADrive(j) & " to/from " & ARemoteShare(j)
  End Select
  Err.Clear
End If

Set objNetwork = Nothing
wscript.echo "Done. "