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
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.