CODEWITHSUNDEEP
vbams-access
Jörgen R
Jörgen R

Reputation: 386

Folder not avalible

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

Upvotes: 2

Views: 69

Answers (1)

Erik A
Erik A

Reputation: 32642

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

Upvotes: 3

Related Questions