Folder not avalible

Question

I am working from home with an Access project. I have a VPN connection to a customer that times out after 15 minutes if I don't use it. If the VPN is up my code below works fine. If the VPN is down the code gets stuck for 60 seconds, checking for a folder that is not available. Is there a way to change this to say 5 seconds and "do something else".

Sub check()
Dim fso As New FileSystemObject
    If fso.FolderExists("z:\abc") Then
        'do something
    else
        'do something else
    End If
End Sub

Looks like that is not possible. See [here](https://stackoverflow.com/q/1667745/5162073). — Brian M Stafford, Jun 01 '20 at 15:09
Thank you for the link. It suggested pinging the server which is fast enough. — Jörgen R, Jun 01 '20 at 15:30
@BrianMStafford It's not possible to make it faster. It is possible to execute the command under a surrogate process, and move on with the main process if the surrogate has not returned a value (in a multithreaded language, one would use a thread for this instead with way less overhead, but VBA unfortunately is single-threaded). Also listed in the bottom answer there. — Erik A, Jun 01 '20 at 15:47

score 3 · Answer 1 · answered Jun 01 '20 at 15:44

You could actually implement this without pinging the server by using a second process to test if the folder exists. This is relevant when the path may or may not refer to a network share, for example.

The code starts a PowerShell process to check if the file exists, then waits for a set amount of time for that PowerShell process to complete, and moves on otherwise.

An added advantage of this approach is that you can call DoEvents while waiting, which will prevent Access from locking up even when waiting for your set timeout.

The disadvantage is that this will cause a considerable overhead if the expected time it'll take to run is short.

Dim strPath As String
strPath = "Z:\abc"
Dim cmd As String
cmd = "powershell.exe -c Test-Path '" & Replace(strPath, "'", "''") & "'"
Dim shellobj As Object
Set shellobj = CreateObject("WScript.Shell")
Dim cmdObject As Object
Set cmdObject = shellobj.Exec(cmd)
Dim startTime As Single
startTime = Timer()
Dim fileExists As Boolean
Dim timeoutReached As Boolean
Do While cmdObject.Status = 0
    If Timer() - startTime > 30 Then
        timeoutReached = True
        Exit Do
    End If
    DoEvents
Loop
If Not timeoutReached Then
    fileExists = Trim(cmdObject.StdOut.ReadAll) = "True" & vbCrLf
End If

_this will cause a considerable overhead if the expected time it'll take to run is short._ You could let a Static variable hold the time of the last call and skip the call if less than 15 minutes have passed. — Gustav, Jun 02 '20 at 07:26
If that's a major consideration, one could also open PowerShell without the `-c` command and keep it open, then send commands using `cmdObject.StdIn.Write`, that avoids the overhead from opening Powershell for every command (which avoids most of the overhead but still provides non-cached results). However, I'd want to encapsulate that into a self-healing predeclared object and that would considerably lengthen this answer. — Erik A, Jun 02 '20 at 07:43

Folder not avalible

1 Answers1