Timing Delays in VBA

Viewed 226035

I would like a 1 second delay in my code. Below is the code I am trying to make this delay. I think it polls the date and time off the operating system and waits until the times match. I am having an issue with the delay. I think it does not poll the time when it matches the wait time and it just sits there and freezes up. It only freezes up about 5% of the time I run the code. I was wondering about Application.Wait and if there is a way to check if the polled time is greater than the wait time.

   newHour = Hour(Now())
   newMinute = Minute(Now())
   newSecond = Second(Now()) + 1
   waitTime = TimeSerial(newHour, newMinute, newSecond)
   Application.Wait waitTime
13 Answers

The handling of midnight in the accepted answer is wrong. It tests for Timer = 0, which will almost never happen. It should instead test for Timer < Start. Another answer tried a correction of Timer >= 86399, but that test can also fail on a slow computer.

The code below handles midnight correctly (with a bit more complexity than Timer < Start). It also is a sub, not a function, because it doesn't return a value, and variables are singles because there is no need for them to be variants.

Public Sub pPause(nPauseTime As Single)

' Pause for nPauseTime seconds.

Dim nStartTime As Single, nEndTime As Single, _
    nNowTime As Single, nElapsedTime As Single

nStartTime = Timer()
nEndTime = nStartTime + nPauseTime

Do While nNowTime < nEndTime
    nNowTime = Timer()
    If (nNowTime < nStartTime) Then     ' Crossed midnight.
        nEndTime = nEndTime - nElapsedTime
        nStartTime = 0
      End If
    nElapsedTime = nNowTime - nStartTime
    DoEvents    ' Yield to other processes.
  Loop

End Sub

For MS Access: Launch a hidden form with Me.TimerInterval set and a Form_Timer event handler. Put your to-be-delayed code in the Form_Timer routine - exiting the routine after each execution.

E.g.:

Private Sub Form_Load()
    Me.TimerInterval = 30000 ' 30 sec
End Sub

Private Sub Form_Timer()

    Dim lngTimerInterval  As Long: lngTimerInterval = Me.TimerInterval

    Me.TimerInterval = 0

    '<Your Code goes here>

    Me.TimerInterval = lngTimerInterval
End Sub

"Your Code goes here" will be executed 30 seconds after the form is opened and 30 seconds after each subsequent execution.

Close the hidden form when done.

Related