Delays Past Midnight

Visual Basic for Applications · Wikibooks

0%

Contents

    Text

    Size
    100%
    Theme
    Typeface
    Line length
    Spacing

    From Wikibooks, under CC BY-SA 4.0, as the source states it. This page at Wikibooks.

    Delays Past Midnight

    Summary

    This VBA module delays for a specified number of seconds. It will work in any MS Office application that can run VBA. The following points are worth noting:

    • Most delay procedures have problems at midnight when the Timer function resets, so code that depends on the difference of two values that span that time will be in error, and will perhaps cause a failure. This procedure avoids such problems by also compensating for the number of lapsed days. As such it will be found useful in timing and clock applications, if not for measuring time, at least for deciding when the display is to be updated. For example; running a delay of twenty seconds from ten seconds to midnight (clock count 86390) to ten seconds after midnight (supposed clock count 86410) would reset at midnight, and would never reach the required end value. The problem is solved by adding one count of 86400 (the number of seconds in one day) to the stepped value for each time that a date transition is made.
    • The anticipated resolution of the procedure is about 10-16mS, consistent with that of the system timer. It is perhaps of interest to note that the GetTickCount API while able to accept millisecond parameters is still limited to the same 10-16mS resolution of the system timer.
    • The procedure parameter can take on integers and fractions of a second, provided comments about resolution are borne in mind.

    The Code

    Copy the following VBA code into a standard module in Excel, Word, or any other Office application that supports VBA.

    Option Explicit
    
    Sub testDelay()
        'tests delay procedure
        
        MsgBox DelaySecs(1.1)    'seconds
    
    End Sub
    
    Function DelaySecs(nSecs As Single) As Boolean
        'Delays for nSecs SECONDS.
        'Avoids midnight reset problem.
        'Typical resolution 10-16mS.
        
        Dim StartDate As Date
        Dim StartTime As Single
        Dim TimeNow As Single
        Dim Lapsed As Single
        
        'get launch date and current timer
        StartTime = Timer
        StartDate = Date
        
        'then loop until lapse of parameter time
        Do
            DoEvents 'allow form updates and breaks
            '86400 seconds per new day
            TimeNow = 86400 * (Date - StartDate) + Timer
            Lapsed = TimeNow - StartTime
        Loop Until Lapsed >= nSecs
        'MsgBox Lapsed
        
        DelaySecs = True
        
    End Function
    

    See Also