excelvbaaudiowavwinmm

How to play multiple WAV files in Excel by VBA asynchronously looped at the same time?


it is first time I am asking for help.

I have checked a lot of websites, even through the WaybackMachine for Excel file from Vienna University and I have not found solution of this. I have checked functions from winmm.dll API such as sndPlaySoundA and mciSendStringA.

I am able to play WAV files looped asynchronously but at the moment it is not possible to play another file looped asynchronously at the same time. As you see below it is possible to combine flags that enables loop and async. I have tried combine it with another flags, but without result I want.

Private Declare Function PlaySound Lib "winmm" Alias "sndPlaySoundA" ( _
    ByVal lpszSoundName As String, _
    ByVal uFlags As Long) As Long

Private Const SND_ASYNC = &H1
Private Const SND_LOOP = &H8
Private Const SND_NODEFAULT = &H2

Private Sub LoopTrack(ByVal sTrack As String)
    Dim lReturnValue As Long
    lReturnValue = PlaySound(sTrack, SND_ASYNC Or SND_LOOP)
    If lReturnValue = 0 Then MsgBox "Can't play " & sTrack
End Sub

Public Sub PlayBackStop()
    Call PlayTrack(vbNullString)
End Sub

Private Sub PlayTrack(ByVal sTrack As String)
    Dim lReturnValue As Long
    lReturnValue = PlaySound(sTrack, SND_ASYNC Or SND_NODEFAULT)
    If lReturnValue = 0 Then MsgBox "Can't play " & sTrack
End Sub

I have also tried code below that plays multiple files asynchronously but not looped. Any idea how to loop multiple files asychronously and control them?

Private Declare Function SendString Lib "winmm" Alias "mciSendStringA" ( _
    ByVal lpstrCommand As String, _
    ByVal lpstrReturnString As String, _
    ByVal uReturnLength As Long, _
    ByVal hwndCallback As Long) As Long

Public Sub PlayMultimedia( _
    ByVal sAliasName As String, _
    Optional ByVal sFirstFrame As String = vbNullString, _
    Optional ByVal sLastFrame As String = vbNullString)

    If sFirstFrame = vbNullString Then sFirstFrame = 0
    If sLastFrame = vbNullString Then sLastFrame = GetTotalFrames(sAliasName)

    Dim sToDo As String * 128
    Dim lReturnValue As Long
    Dim sErrorToReturn As String * 128

    sToDo = "play " & sAliasName & " from " & sFirstFrame & " to " & sLastFrame

    lReturnValue = SendString(sToDo, 0&, 0&, 0&)
    If Not lReturnValue = 0 Then
        GetError lReturnValue, sErrorToReturn, 128
        MsgBox sErrorToReturn
        End
    End If
End Sub

Public Function GetTotalFrames(ByVal sAliasX As String) As Long
    Dim lReturnValue As Long
    Dim sTotalFrames As String * 128

    lReturnValue = SendString("set " & sAliasX & " time format frames", sTotalFrames, 128, 0&)

    lReturnValue = SendString("status " & sAliasX & " length", sTotalFrames, 128, 0&)
    If Not lReturnValue = 0 Then
        GetTotalFrames = -1
        Exit Function
    End If

    GetTotalFrames = Val(sTotalFrames)
End Function

Solution

  • Try to use WMPlayer.OCX, here is the example:

    Dim wmp1
    Dim wmp2
    
    Sub test()
    
        Set wmp1 = CreateObject("new:6BF52A52-394A-11D3-B153-00C04F79FAA6")
        With wmp1
            .url = "C:\Test\sound1.wav"
            .controls.play
            .settings.playCount = 5
        End With
        Set wmp2 = CreateObject("new:6BF52A52-394A-11D3-B153-00C04F79FAA6")
        With wmp2
            .url = "C:\Test\sound2.mp3"
            .controls.play
            .settings.setMode "loop", True
        End With
    
    End Sub
    

    BTW, Set wmp1 = CreateObject("WMPlayer.OCX") and Set wmp1 = New WMPLib.WindowsMediaPlayer with reference to C:\Windows\System32\wmp.dll don't work for me, that is why I use new: moniker.