I got a code after searching google and modified as per my needs
The modified code is as follows:
================================================
Option Explicit
Private StartTime As Double
Private Const PlayForSeconds As Double = 20 'No. of seconds yo
want to play sound
Private Const BaseMusicDirectory As String = "Music" 'The Bas
Directory in which you have music file
Private Declare Function GetShortPathName Lib "kernel32" Alia
"GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPat
As String, ByVal cchBuffer As Long) As Long
Private Declare Function mciGetErrorString Lib "winmm.dll" Alia
"mciGetErrorStringA" (ByVal dwError As Long, ByVal lpstrBuffer A
String, ByVal uLength As Long) As Long
Private Declare Function mciSendString Lib "winmm.dll" Alia
"mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnStrin
As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) A
Long
Public Function SendMeFile2Play(OnlyFileName As String)
PlayMIDI PowerPoint.Application.ActivePresentation.Path & "\"
BaseMusicDirectory & "\" & OnlyFileName, True
End Function
Public Function PlayMIDI(DriveDirFile As String, Optional loopIT A
Boolean)
Dim returnStr As String * 255
Dim Shortpath$, X&
Shortpath = Space(Len(DriveDirFile))
X = GetShortPathName(DriveDirFile, Shortpath, Len(Shortpath))
If X = 0 Then GoTo errorhandler
If X > Len(DriveDirFile) Then 'not a long filename
Shortpath = DriveDirFile
Else 'it is a long filename
Shortpath = Left(Shortpath, X) 'x is the length of the retur
buffer
End If
X = mciSendString("close yada", returnStr, 255, 0) 'just in case
X = mciSendString("open " & Chr(34) & Shortpath & Chr(34) & " typ
sequencer alias yada", returnStr, 255, 0)
If X <> 0 Then GoTo theEnd 'invalid filename or path
X = mciSendString("play yada", returnStr, 255, 0)
If X <> 0 Then GoTo theEnd 'device busy or not ready
If Not loopIT Then Exit Function
StartTime = Timer
Do While True
X = mciSendString("status yada mode", returnStr, 255, 0)
If X <> 0 Then
Exit Function 'StopMIDI() was pressed or error
End If
If (StartTime + PlayForSeconds) > Timer Then
If Left(returnStr, 7) = "stopped" Then
X = mciSendString("play yada from 0", returnStr, 0, 0)
End If
Else
StopMIDI2
' Slide2.TextBox1.Visible = False
Exit Function
End If
' If Slide2.TextBox1.Visible = False Then Slide2.TextBox1.Visible
True
Slide2.TextBox1.Text = CStr(CInt((StartTime + PlayForSeconds)
Timer))
DoEvents
Loop
theEnd: 'MIDI errorhandler
Slide2.TextBox1.Visible = False
returnStr = Space(255)
X = mciGetErrorString(X, returnStr, 255)
MsgBox Trim(returnStr), vbExclamation 'error message
X = mciSendString("close yada", returnStr, 255, 0)
Exit Function
errorhandler:
MsgBox "Invalid Filename or Error.", vbInformation
End Function
Public Function StopMIDI2()
Dim X&
Dim returnStr As String * 255
X = mciSendString("stop yada", 0&, 0, 0)
End Functio
