CODEWITHSUNDEEP
vbams-worddoevents
Adhiraj G Shaji
Adhiraj G Shaji

Reputation: 9

DoEvents delay varies for timer in Word VBA

I used DoEvents to provide a 1 second delay in the VBA execution, to display the countdown in timer properly. The code used was:

time2 = Now + TimeValue("00:00:01")
Do Until Now >= time2
    DoEvents
Loop

I used the above code within another Do Until Loop. The code is showing the countdown, but the delay between each time slightly varies especially for the part displayed within the nested Do Until Loop!!

The rest of the code is:

Sub btnStart_Click()
 Dim time_2 As Variant
 g_position = True

 If g_position = True Then
    UserForm1.StartUpPosition = 0
    UserForm1.Left = Application.Left + 0.5 * Application.Width +    UserForm1.Width + 72
    UserForm1.Top = Application.Top + (0.5 * Application.Height) - (UserForm1.Height) - 36
 End If

 start = Now
 timeEnd = start + TimeValue("00:00:10")
 g_start = Format(start, "hh:mm:ss")
 g_timeEnd = Format(timeEnd, "hh:mm:ss")
 time_duration = timeEnd - start
 g_time_duration = Format(time_duration, "hh:mm:ss")
 Label1.Visible = True
 time_left.Caption = g_time_duration
 time_left.Visible = True
 btnStart.Visible = False
 time_2 = Now + TimeValue("00:00:01")
 Do Until Now >= time_2
    DoEvents
 Loop
 g_temp = Format(temp, "hh:mm:ss")
 etime = start + TimeValue("00:00:01")
 time_duration = timeEnd - etime
 g_time_duration = Format(time_duration, "hh:mm:ss")
 time_left.Caption = g_time_duration
 time_2 = Now + TimeValue("00:00:01")
 Do Until Now >= time_2
    DoEvents
 Loop
 Call modtimer.time_count(time_duration, etime, timeEnd, g_time_duration)

End Sub

The Module Code:

Sub time_count(time_duratn As Variant, etim As Variant, timEnd As Variant, g_time_duratn As Variant)

 temp_end = Format(TimeValue("00:00:00"), "hh:mm:ss")
 temp_alert = Format(TimeValue("00:00:05"), "hh:mm:ss")
 etim = etim + TimeValue("00:00:01")
 time_duratn = timEnd - etim
 g_time_duratn = Format(time_duratn, "hh:mm:ss")
 UserForm1.time_left.Caption = g_time_duratn
 time2 = Now + TimeValue("00:00:01")
 Do Until Now >= time2
    DoEvents
 Loop
 Do Until g_time_duratn = temp_end
    If g_time_duratn = temp_alert Then
        Beep
        MsgBox "Only 5 minutes remaining", vbInformation
    End If
    etim = etim + TimeValue("00:00:01")
    time_duratn = timEnd - etim
    g_time_duratn = Format(time_duratn, "hh:mm:ss")
    UserForm1.time_left.Caption = g_time_duratn
    time2 = Now + TimeValue("00:00:01")
    Do Until Now >= time2
        DoEvents
    Loop
 Loop
 End_Exam
End Sub

Why is the delay in the countdown varying? Can anybody help?

Upvotes: 0

Views: 1163

Answers (1)

LS_ᴅᴇᴠ
LS_ᴅᴇᴠ

Reputation: 11151

You are getting different time spans because Now, as far as I tested, as 1 second resolution in Office VBA. So, Now will always round time to last second.

Eg, you start waiting at 00:00:00.500, Now will return #00:00:00#. When time reach 00:00:01.000, Now will return #00:00:01#, so you think you get 1 second delay, but it was just 0.5! Using Now you may "measure" 1 second time delays which may vary between 0 to 1 second!

As workaround, WinAPI GetLocalTime may be used to get 1 milisecond resolution timestamps:

Private Declare Sub GetLocalTime Lib "Kernel32" (lpSystemTime As Any)

Function Now_ms() As Date
    Dim st(0 To 7) As Integer
    GetLocalTime st(0)
    Now_ms = DateSerial(st(0), st(1), st(3)) + TimeSerial(st(4), st(5), st(6)) + st(7) / 1000# * #12:00:01 AM#
End Function

Replace Now with Now_ms, which is full compatible with Date data type and returns a better resolution timestamp (1ms).

Better resolution timestamps can be achieved using GetSystemTimePreciseAsFileTime (0.1μs) or QueryPerformanceCounter.

Upvotes: 3

Related Questions