Option Declare

Dim mappedDrives As Boolean
Sub Initialize
Call mapNetworkDrives
If Not mappedDrives Then Exit Sub
End Sub
Sub mapNetworkDrives
Dim network As Variant
Set network = createobject("WScript.Network")
Dim drivesAreGood As Boolean
drivesAreGood = checkMapping("h:", "\\emrml01\projects") 'substitute your own drive letter and UNC path here.

If drivesAreGood Then
Messagebox "Drive H is mapped to \\emrml01\Projects",0,"Drive mapped correctly"
mappedDrives = True
Else
Messagebox "Drive H is not mapped to \\emrml01\Projects. I will now attempt to map it myself.",0,"Drive not mapped correctly"
Call network.MapNetworkDrive("H:", "\\emrml01\Projects")
'see if we were able to connect
If checkMapping("h:", "\\emrml01\projects") Then
Messagebox "I did it!! Drive H is mapped to \\emrml01\Projects",0,"Drive mapped correctly"
mappedDrives = True
Else
Messagebox "Can't map the drive. Your H drive must be mapped to \\emrml01\Projects to proceed. Please connect to the network.",0,"Stopping"
End If
End If

End Sub
Function checkMapping(driveLetterCheck As String, uncCheck As String) As Boolean
'given drive letter and unc path, check to make sure it's mapped OK.
Dim i As Integer
Dim drives As Variant
Dim net As Variant
Dim networkResult As Variant
Dim driveLetter As String
Dim unc As String
Dim drivesAreGood As Boolean

Set net = createobject("WScript.Network")
Set drives = net.EnumNetworkDrives()
checkMapping = False

For i = 0 To drives.Count() - 1 Step 2
driveLetter = Lcase(drives.Item(i))
unc = Lcase(drives.Item(i+1))
If driveLetter = driveLetterCheck And unc = uncCheck Then
checkMapping = True
Exit For
End If
Next
End Function