26.10.09

Vbscript to Map Drive Based of availability of Drive Letter

Vbscript to Map Drive Based of availability of Drive Letter
This script will maps from Drive Letter ‘K’ up to Y


Option Explicit
Dim strDriveLetter, strRemotePath
Dim objNetwork, objShell
Dim CheckDrive, DriveExists, intDrive

Dim strAlpha, strExtract, intAlpha, intCount


strRemotePath = "\\ServerName\ShareName"
strDriveLetter = "K:"
strAlpha = "LMNOPQRSTUVWXY"
intAlpha = 0
intCount = 0
err.number= vbEmpty

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

On Error Resume Next
DriveExists = False
' Sets the Outer loop to check for 5 letters in strAlpha
For intCount = 1 To 8
DriveExists = False

' CheckDrive compares each Enumerated network drive
' with the proposed drive letter held by strDriveLetter
For intDrive = 0 To CheckDrive.Count - 1 Step 2
If CheckDrive.Item(intDrive) = strDriveLetter _
Then DriveExists = True
Next
intAlpha = intAlpha + 1


'Wscript.Echo strDriveLetter & " exists: " & DriveExists

If DriveExists = False Then objNetwork.MapNetworkDrive _
strDriveLetter, strRemotePath
call ShowExplorer

strDriveLetter = Mid(strAlpha, intAlpha,1) & ":"


If DriveExists = True Then DriveExists = False

Next

WScript.Echo "Out of drive letters. Last letter " & strDriveLetter

WScript.Quit(1)

Sub ShowExplorer()
If DriveExists = False Then
MsgBox strDriveLetter
End if

If DriveExists = False Then WScript.Quit(0)
End Sub

No comments:

Post a Comment