Precisely synchronise playing wav file with system clock

Alex Simmons

New Member
Joined
Dec 3, 2012
Messages
17
I am attempting to precisely synchronise the playing of an audio wav file with the system clock. I need it to reliably start playing in sync with the clock every time, or at least with a predictable and consistent delay. At present the start delay is not consistent, sometimes it's right on cue, while sometimes it has a delay of ~1 second.

It's for a sporting count down timer, hence why having it play on cue is important to me.

The wav file I created (TTstart2.wav) is 10.800 seconds long and provides a 800ms beep at 10 seconds to go, then 250ms beeps at 5, 4, 3, 2, and 1 seconds to go, and then a long 800ms higher frequency beep at zero seconds.

I'm using Excel 2010 VBA.

I've no problem in getting the wav file to play, I just used the PlayWAV code I found online and included below.

The problem is getting it to play right on cue every time.

It does so most of the time, but no matter what way I make the call to play the wav file, occasionally it has a start delay. I've tried all sort of timing loops (my actual code has countdown timers displayed).

It happens once in about every 4 or 5 times it's called to play and I don't understand why or how to fix it, or what an alternative approach might be to sync an audio file with the system clock. Perhaps Excel VBA can't actually manage such things with such timing precision.

This is some code I have to demonstrate the problem (my code where it occurs is embedded in other more complex stopwatch timer arrangement so I replicated the problem in a more simple example).

Code:
Option Explicit


Private Declare Function PlaySound Lib "winmm.dll" _
  Alias "PlaySoundA" (ByVal lpszName As String, _
  ByVal hModule As Long, ByVal dwFlags As Long) As Long


Const SND_SYNC = &H0
Const SND_ASYNC = &H1
Const SND_FILENAME = &H20000


'----------------------------------------


Sub PlayWAV()
    Dim WAVFile As String
    WAVFile = "TTstart2.wav"
    ' TTstart2.wav is my own audio wav file
    
    WAVFile = ThisWorkbook.Path & "\" & WAVFile
    ' I've put the wav file in same folder as the workbook
    
    Call PlaySound(WAVFile, 0&, SND_ASYNC Or SND_FILENAME)
    ' this plays the wav file in asynchronous mode meaning it does not stop other code
    
End Sub


'----------------------------------------


Sub repeatplayaudio()
    Dim audiostart As Range
    Dim i As Integer
    Dim H, M, S, playtime As String
    
  ' loop through the start times listed in chronological order in column A1:A8
  
  ' before running this sub:
  
  ' in my sheet I put a start time in cell A1 which is just into the future
  ' and then have 15 second gaps between each subsequent cell
  ' e.g. if it's currently 9:09:00AM in cell A1 I put 9:10:00AM
  ' then cell A2  = A1 + 15/24/3600
  ' and copy down
  
    For i = 1 To 8
    
      ' choose next cell in column A
        Set audiostart = Range("A" & i)
      
      ' wait until start time arrives
        Do While audiostart.Value > Now
        Loop
        
      ' once start time has arrived then play the audio file
      ' set the hour, minute and second into a string for the OnTime function
        H = Hour(audiostart.Value)
        M = Minute(audiostart.Value)
        S = Second(audiostart.Value)
        playtime = H & ":" & M & ":" & S
        
        Application.OnTime TimeValue(playtime), "PlayWAV"
        
    Next i
    
End Sub

The problem is that no matter what method I use to call a sub to play the wav file (be it Application.OnTime, or various timing loops, timer delays subs etc), about every 4th or 5th time the wav file is delayed by about a second. All other times it plays right on cue, but for some reason there is an occasional delay and I can't work out why.

Any suggestions?

Thanks!
 

Excel Facts

Show numbers in thousands?
Use a custom number format of #,##0,K. Each comma after the final 0 will divide the displayed number by another thousand
My guess it's a rounding of the time error.
I don't think the time can be guaranteed to be that precise via Excel.
There's another post with a similar query here...

vba - How do I show a running clock in Excel? - Stack Overflow

I've been able to do timers and countdown clocks with fine precision using the inbuilt Timer function, which provides seconds since midnight with at least millisecond precision.

Just put a defined range = Timer into a loop
 
Upvote 0
I don't see why you're using a loop to wait for the start time to arrive and then calling Application.OnTime. The loop (and code after it) will likely cause imprecision in the timing. Try just calling Application.OnTime (I tested your code and the 1st argument needed to be Date + audioStart.Value, if the times in the cells are just hh:mm:ss times), and schedule the next timer in the PlayWav routine (you'll have to rearrange the code slightly). Better still, for more precision, use a Windows timer with SetTimer instead of Application.OnTime.
 
Upvote 0
I don't see why you're using a loop to wait for the start time to arrive and then calling Application.OnTime. The loop (and code after it) will likely cause imprecision in the timing. Try just calling Application.OnTime (I tested your code and the 1st argument needed to be Date + audioStart.Value, if the times in the cells are just hh:mm:ss times), and schedule the next timer in the PlayWav routine (you'll have to rearrange the code slightly). Better still, for more precision, use a Windows timer with SetTimer instead of Application.OnTime.
OK thanks, I'll look into using SetTimer.

My original code doesn't use Application.OnTime, it was just testing a condition inside the loop and if met it then called the sub to play the audio file. I just tried Application.OnTime as an alternative thinking maybe it might do a better job. It didn't seem to matter how I made the call to play the audio file, every so often it went out of sync.

The reason I have a loop is that my sheet/code operates as both a visual and an audio countdown timer and I use a loop to constantly update the display with the latest countdown time, current time of day, and that then drives other key display information, such as which rider is up next, and riders to follow and so on.

Here's a 45-sec youtube to show what it looks like:
https://youtu.be/RbURxD_N2pI

I ruled out external factors causing a delay in playing the .wav file (e.g. hardware drive accessing file) as I have commercial stopwatch software as well that can play a wav file at end of a countdown loop, and it never misses a beat.
 
Upvote 0
OK, I've rewritten using SetTimer as described in the section Using Windows Timers here:
Pearson Software Consulting

It's a much less CPU resource intensive approach but is very touchy, I don't have to do much to crash Excel.

It updates the current time in a cell and checks the countdown (difference between rider's start time and current time) and when it hits less than a trigger number of seconds the PlayWAV sub is called.

I've tried setting the timer to poll at 1 second, 0.2 second, 0.1 second and even shorter intervals but no matter what I do, about every 5th time though the playing of the wav file is delayed by about a full second.

It's pretty frustrating!
 
Upvote 0
I tried this very basic code to call playing of the .wav file using a series of Application.OnTime calls.

Code:
Option Explicit


Private Declare Function PlaySound Lib "winmm.dll" _
  Alias "PlaySoundA" (ByVal lpszName As String, _
  ByVal hModule As Long, ByVal dwFlags As Long) As Long


Const SND_SYNC = &H0
Const SND_ASYNC = &H1
Const SND_FILENAME = &H20000


Sub PlayWAV()
    Dim WAVFile As String
    WAVFile = "TTstart2.wav"
    ' TTstart2.wav is my own audio wav file
    
    WAVFile = ThisWorkbook.Path & "\" & WAVFile
    ' I've put the wav file in same folder as the workbook
    
    Call PlaySound(WAVFile, 0&, SND_ASYNC Or SND_FILENAME)
    ' this plays the wav file in asynchronous mode meaning it does not stop other code
    
End Sub




Sub repeatplay()


Application.OnTime TimeValue("16:36:05"), "PlayWAV" ' play#01
Application.OnTime TimeValue("16:36:20"), "PlayWAV" ' play#02
Application.OnTime TimeValue("16:36:35"), "PlayWAV" ' play#03
Application.OnTime TimeValue("16:36:50"), "PlayWAV" ' play#04
Application.OnTime TimeValue("16:37:05"), "PlayWAV" ' play#05
Application.OnTime TimeValue("16:37:20"), "PlayWAV" ' play#06
Application.OnTime TimeValue("16:37:35"), "PlayWAV" ' play#07
Application.OnTime TimeValue("16:37:50"), "PlayWAV" ' play#08
Application.OnTime TimeValue("16:38:05"), "PlayWAV" ' play#09
Application.OnTime TimeValue("16:38:20"), "PlayWAV" ' play#10
Application.OnTime TimeValue("16:38:35"), "PlayWAV" ' play#11
Application.OnTime TimeValue("16:38:50"), "PlayWAV" ' play#12




End Sub

The times listed in the sub repeatplay are at 15 second intervals (it's a 10-second audio countdown) and so that's 3 minutes worth with 4 calls per minute.

it's just test code to see how it goes in running a basic call on time. No code loops, no ongoing timers set.

As per my previous experience, every 5th call is delayed by about a full second, the rest occur on time (or at least close enough not to notice any time delay).

It doesn't seem to matter what method I use to call playing the .wav file, there is an occasional 1 seconds delay and it happens it seems about every 5th occasion the call is made.
 
Upvote 0
I ran this code to see how consistent the triggering of Application.OnTime is:

Code:
Option Explicit

Public i As Integer


Private Sub Add_Schedule()


  ThisWorkbook.Sheets(1).Range("A1") = Timer
  Range("B" & i + 1).Value = Range("A1").Value
  i = i + 1
  Application.OnTime Now + TimeValue("00:00:01"), "Add_Schedule"


End Sub

Essentially each second it updates cell A1 with the timer value, then copies that value each time into cells B1 thru B(i+1) for as long as I let the sub run. I let it do 1000 iterations.

Then I did a analysis on the time gaps between the timer updates.

Average:
1.000004 seconds
Std Dev:
0.025 seconds
Max time gap:
1.184 seconds
Min time gap: 0.859 seconds

<tbody>
</tbody>

So on average the time gaps were good but there is a standard deviation of 25ms
The occasional time gap was out by up to ~100ms, but mostly these were on the low side.

I also did a frequency count and found:

77% of time gaps were between 0.995 - 1.025 seconds
3% of time gaps were longer than 1.025 seconds,
20% had time gaps of less than 0.995 seconds.

That 20% is similar to the frequency I observed the .wav playing subroutine being triggered late, and to be late by about a full second.


So I think this is what's happening:

i. The countdown timer has to reach/pass a trigger value in order to fire the sub.

ii. for 80% of the time, the trigger time value is passed, and the call to subroutine to play the .wav file happens, albeit with some smaller variation in timing (mostly within a 30ms range). 30ms is OK for this application. I'd rather it was right on time but that will do.

iii. for 20% of the time though it falls just short of reaching the trigger time, and it needs another iteration to pass the trigger time and to fire the subroutine, and of course that doesn't happen for another second.


OK, so that might explain Application.OnTime calls resulting in 1 second long occasional delays in code where the timer is updated each second, but it still doesn't quite explain why other timer loops which update more frequently are still missing the mark.

So for now I can't assume the above is causative of the occasional delays, just a correlation.


Either way, I still don't have a solution yet that reliably fires the subroutine on time.
 
Upvote 0
I think part of the imprecision is caused by the VBA Timer function, which only has a resolution of a few milliseconds and seems to be subject to rounding.

Instead of the VBA Timer function, try high-resolution timers using the Windows functions QueryPerformanceFrequency and QueryPerformanceCounter. They aren't really timers, but high-resolution counters and can be used to generate a stopwatch or countdown clock - see Accurate Performance Timers in VBA | Byte Comb. You might also want to read the mentioned MSDN Magazine article Implement a Continuously Updating, High-Resolution Time Provider for Windows, which is available in the March 2004 issue as a Windows .chm help file (after you have downloaded the .chm file you must Unblock it via the file's properties before the articles contained inside can be accessed).

The following code, based on https://support.microsoft.com/en-us/kb/184796, uses the performance counters, along with a waitable timer (see https://msdn.microsoft.com/en-us/li...ms644900(v=vs.85).aspx#waitable_timer_objects).

It loops MAX_ROWS times and puts the start and end counters in columns A and B and the elapsed time formula in column C of Sheet2.

Code:
Option Explicit

Private Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type

Private Declare Function QueryPerformanceCounter Lib "kernel32" (lpPerformanceCount As Currency) As Long
Private Declare Function QueryPerformanceFrequency Lib "kernel32" (lpPerformanceCount As Currency) As Long

Private Declare Function CreateWaitableTimer Lib "kernel32" Alias "CreateWaitableTimerA" (ByVal lpSemaphoreAttributes As Long, ByVal bManualReset As Long, ByVal lpName As String) As Long
Private Declare Function SetWaitableTimer Lib "kernel32" (ByVal hTimer As Long, lpDueTime As FILETIME, ByVal lPeriod As Long, ByVal pfnCompletionRoutine As Long, ByVal lpArgToCompletionRoutine As Long, ByVal fResume As Long) As Long
Private Declare Function CancelWaitableTimer& Lib "kernel32" (ByVal hTimer As Long)
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

Private Declare Function SleepEx Lib "kernel32" (ByVal dwMilliseconds As Long, ByVal bAlertable As Long) As Long


Private Const INFINITE = &HFFFFFFFF
Private Const MAX_ROWS = 20

Private counterFreq As Currency
Private startCounter As Currency
Private rowNum As Long
Private destSheet As Worksheet


'This uses a waitable timer and high-resolution counters in a loop.  The timer triggers an asynchronous call to TimerProc2.
'The start and end counters are written directly to cells, using global variables above

Public Sub Main_HiResTimer_TimerProc2()
    
    Dim timerDueMilliseconds As Long
    Dim timerPeriodMilliseconds As Long
    Dim hTimer As Long
    Dim dueTime As FILETIME  'Time passed to SetWaitableTimer
    
    Set destSheet = ThisWorkbook.Worksheets("Sheet2")
    With destSheet
        .Activate
        .Cells.Clear
        .Range("A1:C1").Value = Array("Start", "End", "Elapsed")
        .Columns("A:C").NumberFormat = "0.000000"
    End With
    
    timerDueMilliseconds = 2000         'first timer signal occurs after this number of milliseconds
    timerPeriodMilliseconds = 1000      'subsequent timer signals occur after this number of milliseconds
    
    QueryPerformanceFrequency counterFreq
    
    hTimer = CreateWaitableTimer(0, True, "Timer1")
    
    dueTime.dwHighDateTime = -1
    dueTime.dwLowDateTime = CLng(timerDueMilliseconds * -10000)
    
    'Start periodic timer
    
    SetWaitableTimer hTimer, dueTime, timerPeriodMilliseconds, AddressOf TimerProc2, 0, False
    
    'Loop for MAX_ROWS, waiting each time for timer to signal
    
    QueryPerformanceCounter startCounter
    For rowNum = 2 To MAX_ROWS + 1
        SleepEx INFINITE, True
    Next
    
    CancelWaitableTimer hTimer

    CloseHandle hTimer
        
    'Put time difference formula in column C
    
    With destSheet.Range("C2")
        .FormulaR1C1 = "=RC[-1]-RC[-2]"
        .AutoFill Destination:=.Resize(MAX_ROWS, 1), Type:=xlFillDefault
    End With
        
End Sub


Public Sub TimerProc2(ByVal lpArg As Long, ByVal dwTimerLowValue As Long, ByVal dwTimerHighValue As Long)

    Dim endCounter As Currency
    
    QueryPerformanceCounter endCounter
    
    destSheet.Cells(rowNum, 1).Value = startCounter / counterFreq
    destSheet.Cells(rowNum, 2).Value = endCounter / counterFreq
    
    startCounter = endCounter
    
End Sub
 
Last edited:
Upvote 0
I think part of the imprecision is caused by the VBA Timer function, which only has a resolution of a few milliseconds and seems to be subject to rounding.

Instead of the VBA Timer function, try high-resolution timers using the Windows functions QueryPerformanceFrequency and QueryPerformanceCounter.

Thanks

I modified the code by adding in the PlayWAV routine, and then set the loop to trigger every 15,000 milliseconds.

I still get the same occasional delay of about a second in the audio file playback.

So perhaps it's less of an issue with the triggering of the subroutine on time (although that may still be an issue) and more about the audio file commencing immediately every time.
 
Upvote 0

Forum statistics

Threads
1,214,583
Messages
6,120,378
Members
448,955
Latest member
BatCoder

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top