Search notes:

VBA class: timeAccumulator

timeAccumulator is a VBA class that allows to measure elapsed time to accumulated multiple measurements.
The class provides three methods: startAccumulating, stopAccumulating and elapsed_mselapsed_ms`.
stopAccumulating returns the time that was spent since the last call of startAccumulating in ticks and adds this amount to the member variable accumulatedTime.
elapsed_ms reports the accumulated time that was spent between alternating calls of stopAccumulating and stopAccumulating in milli-seconds.

Simple test

option explicit

public declare ptrSafe sub Sleep lib "kernel32" (byVal Milliseconds as longPtr)

sub main() ' {

    dim ta_1, ta_2, ta_3 as timeAccumulator

    set ta_1 = new timeAccumulator
    set ta_2 = new timeAccumulator
    set ta_3 = new timeAccumulator

    dim i         as long
    dim totalTime as double

    ta_1.startAccumulating
         for i = 1 to 10000
             ta_2.startAccumulating
             ta_2.stopAccumulating
         next i

    totalTime = ta_1.stopAccumulating

    debug.print "accumulator 1:    " & ta_1.elapsed_ms
    debug.print "accumulator 2:    " & ta_2.elapsed_ms
    debug.print "totalTime:        " & totalTime

    dim approx_1_second, approx_1000_ms as double
    ta_3.startAccumulating
         sleep 1000
    approx_1_second = ta_3.stopAccumulating / ta_3.freq
    approx_1000_ms  = ta_3.elapsed_ms
    debug.print "approx_1_second:  " & approx_1_second
    debug.print "approx_1000_ms:   " & approx_1000_ms

end sub ' }
Github repository VBAModules, path: /_test/Common/Date-Time/timeAccumulator.bas
The test is run using the VBScript MS-Office App Creator, the source code of the driver is on github.

Source Code

'
' vi: ft=basic
'
' Measure accumulated time
'
' https://stackoverflow.com/a/198702/180275 was helpful
'
' Version 0.02 - make stopAccumulating a function
'

private type LARGE_INTEGER ' { winnt.h
    LowPart  as long
    HighPart as long
end type ' }

private declare function QueryPerformanceCounter   lib "kernel32" (lpPerformanceCount as LARGE_INTEGER) as long ' profileapi.h
private declare function QueryPerformanceFrequency lib "kernel32" (lpFrequency        as LARGE_INTEGER) as long

const two_32 as double = 4294967296# ' 256^4

public  freq            as double
private accumulatedTime as double
private startedTime     as double

private sub class_initialize() ' {
    accumulatedTime = 0

    dim freq_ as LARGE_INTEGER
    QueryPerformanceFrequency freq_

    freq = LARGE_INTEGER_2_double(freq_)

end sub ' }

private function LARGE_INTEGER_2_double(li as LARGE_INTEGER) as double ' {

    LARGE_INTEGER_2_double = li.LowPart
    if LARGE_INTEGER_2_double < 0 then
       LARGE_INTEGER_2_double = LARGE_INTEGER_2_double + two_32
    end if

    LARGE_INTEGER_2_double = li.HighPart * two_32 + LARGE_INTEGER_2_double

end function ' }

public sub startAccumulating() ' {

    dim li as LARGE_INTEGER
    QueryPerformanceCounter li
    startedTime = LARGE_INTEGER_2_double(li)

end sub ' }

public function stopAccumulating() as double ' {
  '
  ' This function determines the amout of time spent, in ticks, since
  ' the last call of startAccumulating and returns that value.
  '
  ' It also adds this ammount to the member accumulatedTime so that
  ' all time periodes measured can be queried with elapsed_ms()
  '

    dim li as LARGE_INTEGER
    QueryPerformanceCounter li

    stopAccumulating = LARGE_INTEGER_2_double(li) - startedTime

    accumulatedTime = accumulatedTime + stopAccumulating

end function ' }

public function elapsed_ms() as double ' {
    elapsed_ms = 1000# * accumulatedTime / freq
end function ' }
Github repository VBAModules, path: /Common/Date-Time/timeAccumulator.cls

History

Version 0.02 make stopAccumulating a function

See also

The VBA function timer

Index