Open a database and sound plays

[ddennis]

Good day:

I have created a colorful database. I would like the database to play a wav file when it is opened.

Any ideas?

Many thanks,

Dion ray:

 

[DaveSwanton77]

Copy and paste the code below into a new module

It will play avi,mid and wav extensions and these must be specified in the file name

To test it open the immediate window (ctrl+g) in the VBA window and type

?fPlaySound("C:\Program Files\NetMeeting\Testsnd.wav")

A sound should then be heard

The function is called by placing fplaySound(filename) in your splash screens code.


Option Compare Database
Option Explicit

Private Declare Function apiPlaySound Lib "Winmm.dll" Alias "sndPlaySoundA" _
(ByVal lpszSoundName As String, ByVal uFlags As Long) As Long

Private Declare Function apimciSendString Lib "Winmm.dll" Alias "mciSendStringA" _
(ByVal lpstrCommand As String, ByVal lpstrReturnString As String, _
ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long

Private Declare Function apimciGetErrorString Lib "Winmm.dll" _
Alias "mciGetErrorStringA" (ByVal dwError As Long, _
ByVal lpstrBuffer As String, ByVal uLength As Long) As Long


Function fPlaySound(ByVal strFilename As String, _
Optional intPlayMode As Integer) As Long

Dim lngRet As Long
Dim strTemp As String

On Error GoTo Err_fPlaySound

Select Case LCase(fFileExt(strFilename))
Case "wav":
If Not IsMissing(intPlayMode) Then
lngRet = apiPlaySound(strFilename, intPlayMode)
Else
MsgBox "Must specify play mode."
Exit Function
End If
Case "avi", "mid":
strTemp = String$(256, 0)
lngRet = apimciSendString("play " & strFilename, strTemp, 255, 0)
End Select
fPlaySound = lngRet

Exit_Err_fPlaySound:
Exit Function

Err_fPlaySound:
MsgBox Err.Description, vbCritical + vbSystemModal, "Error"
Resume Exit_Err_fPlaySound

End Function



Private Function fFileExt(ByVal strFullPath As String) As String
Dim intPos As Integer, intLen As Integer
On Error GoTo Err_fFileExt

intLen = Len(strFullPath)
If intLen Then
For intPos = intLen To 1 Step -1
If Mid$(strFullPath, intPos, 1) = "." Then
fFileExt = Mid$(strFullPath, intPos + 1)
Exit Function
End If
Next intPos
End If

Exit_Err_fFileExt:
Exit Function

Err_fFileExt:
MsgBox Err.Description, vbCritical + vbSystemModal, "Error"
Resume Exit_Err_fFileExt

End Function


HTH

Cheers

Dave

 

[ddennis]

Many thanks dave. I wil give it a try

Dion