Check if mapped network available

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 st

Answer 1

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 2

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

Answer 3

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