Skip navigation

'||==========================================||
'||Author Daniel Belcher ||
'||Function drivemounter ||
'||Date 5/4/2011 ||
'||==========================================||
'|Objects and Variables **********************
'\--------------------------------------------/
'|Set number of items in array '|
'|Example: 3 drives would be (3,1) and 3 '|
Dim ArrDrive(6,1) '|
DriveCount = 7 '|
Dim strSvr '|
strSvr = "servertoping" '|
'|--------------------------------------------|
'|Define the Array to read '|
arrDrive(0,0) = "h:" '|
arrDrive(0,1) = "\\uncpath\1" '|
arrDrive(1,0) = "i:" '|
arrDrive(1,1) = "\\uncpath\2" '|
arrDrive(2,0) = "j:" '|
arrDrive(2,1) = "\\uncpath\3" '|
arrDrive(3,0) = "k:" '|
arrDrive(3,1) = "\\uncpath\4" '|
arrDrive(4,0) = "l:" '|
arrDrive(4,1) = "\\uncpath\5" '|
arrDrive(5,0) = "m:" '|
arrDrive(5,1) = "\\uncpath\6" '|
arrDrive(6,0) = "n:" '|
arrDrive(6,1) = "\\uncpath\7" '|
'\--------------------------------------------\
Const DEBUGMSG = True 'True = Debug Messages, False = No Messages
Dim oWShell
Set oWShell = CreateObject("WScript.Shell")
Dim oWNet
Set oWNet = CreateObject("WScript.Network")
Dim oWMISvc
Set oWMISvc = GetObject _
("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
Dim oPing
Set oPing = oWMISvc.ExecQuery _
("Select StatusCode From Win32_PingStatus where Address = '"&strSvr&"'")
'|Main Run *******************************************
DriveMount 'Perform Function DriveMount
Report 'Perform Function Report
Wscript.Quit 'Close Script
'SubRoutines and Procedures **************************
Sub Mount(letter,path)
oWNet.MapNetworkDrive letter,path
End Sub
'*****************************************************
Sub Umount(letter)
oWNet.RemoveNetworkDrive letter
End Sub
'|Functions ******************************************
Function DriveMount
'http://msdn.microsoft.com/en-us/library/aa394350(v=vs.85).aspx
For Each item in oPing
If IsNull(item.StatusCode) or item.StatusCode<>0 Then
'**********Domain not reachable, unmount drives in arrDrive
x = 0
do until x=DriveCount
On Error Resume Next
Umount arrDrive(x,0)
If debugmsg then msgbox "Umount"& vbcrlf _
&"Drive Letter: "&arrDrive(x,0)& vbcrlf _
& "Error Number: "&Err.Number& vbcrlf _
& "Error: "&Err.Description
Err.Clear
x = x + 1
loop
else
'**********Domain exists, mount drives from arrDrive
x = 0
do until x=DriveCount
On Error Resume Next
Mount arrDrive(x,0), arrDrive(x,1)
If debugmsg then msgbox "Mount"& vbcrlf _
&"Drive Letter: "&arrDrive(x,0)& vbcrlf _
& "Error Number: "&Err.Number& vbcrlf _
& "Error: "&Err.Description
Err.Clear
x = x + 1
loop
End if
Next
End Function
'*****************************************************
Function Report
If Debugmsg then msgbox "Script completed"
End Function
'End *************************************************

Advertisements

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s

%d bloggers like this: