Check if mapped network available - vba

Question

I am trying to have my program check is a mapped network drive is actually connected, and change the curDrive variable based on the result. It works okay, but if the drive is still mapped and the drive is not available, there is a long delay while the program tries to connect (4-6 seconds). I tried two methods and both ways have this delay. I tried the following:
On Error GoTo switch
checker= Dir("F:\")
If checker= "" Then GoTo switch
curDrive = "F:\"
GoTo skip
switch:
curDrive = "C:\"
skip:
........
I also tried:
Dim FSO As Object '//FileSystemObject
Dim f As Object '//File Object
Set FSO = CreateObject("Scripting.FileSystemObject")
With FSO
If .FolderExists("F:\Sample") Then
curDrive = "F:\"
Else
curDrive = "C:\"
End If
End With
Both have the same delay.

Answer 1

After much searching and brainstorming, I put together some info from here and from elsewhere and came up with a method that takes half a second. Basically, I'm pinging the server and reading the results from a text file. I'm also checking to make sure that the F: Drive (the server drive) is available (Someone can be on the server but hasn't set the F: Drive to the server).
Private Declare Function CloseHandle Lib "kernel32.dll" (ByVal hObject As Long) As Long
Private Declare Function WaitForSingleObject Lib "kernel32.dll" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function OpenProcess Lib "kernel32.dll" (ByVal dwDesiredAccessas As Long, ByVal bInheritHandle As Long, ByVal dwProcId As Long) As Long
Sub CheckAllConnections()
ServerOn = ComputerIsOnline("server.mmc.local")
FDrive = CreateObject("scripting.filesystemobject").driveexists("F")
test = FDrive - 1
ProgramFolder = False
If ServerOn + FDrive = -2 Then
ProgramFolder = Len(Dir("F:\SampleProgram\")) > 0
End If
MsgBox ("Server connection is " & ServerOn & "." & Chr(10) & "F: Drive available is " & FDrive _
& Chr(10) & "The Program Folder availability is " & ProgramFolder)
End Sub
Public Function ComputerIsOnline(ByVal strComputerName As String) As Boolean
On Error Resume Next
Kill "C:\Logger.txt"
On Error GoTo ErrorHandler
ShellX = Shell("cmd.exe /c ping -n 1 " & strComputerName & " > c:\logger.txt", vbHide)
lPid = ShellX
lHnd = OpenProcess(&H100000, 0, lPid)
If lHnd <> 0 Then
lRet = WaitForSingleObject(lHnd, &HFFFF)
CloseHandle (lHnd)
End If
FileNum = FreeFile
Open "c:\logger.txt" For Input As #FileNum
strResult = Input(LOF(1), 1)
Close #FileNum
ComputerIsOnline = (InStr(strResult, "Lost = 0") > 0)
Exit Function
ErrorHandler:
ComputerIsOnline = False
Exit Function
End Function

Answer 2

Both show the same delay because both methods invoke the same underlying OS functionality to check for the presence of the network drive.
The OS is giving the external resource time to be available. I don't think you can do anything except await the timeout, if you want to know for sure.
If you know that, in your environment the OS timeout is just too long (e.g. "If it has not responded after 1 second, it will not respond), you could use a mechanism such as a timer to avoid waiting the full duration (set a 1 second timer when you start checking, if the timer fires and you still have no reply, the drive was not present).

Answer 3

There is no long delay when testing for a drive letter using the FileSystemObject and DriveExists:
Sub Tester()
Dim n As Integer
For n = 1 To 26
Debug.Print Chr(64 + n), HaveDrive(Chr(64 + n))
Next n
End Sub
Function HaveDrive(driveletter)
HaveDrive = CreateObject("scripting.filesystemobject").driveexists(driveletter)
End Function