CODEWITHSUNDEEP
vbaplayback
ChrisB
ChrisB

Reputation: 3215

Play Sound in Windows 11 with VBA

How can I use VBA to play sounds in Windows 11? The code below worked in Windows 10 but does nothing in Windows 11.

Code execution does not throw an error.

I verified the sound file referenced in the code exists in Windows 11 and played it back successfully in VLC but nothing plays when this VBA code is run.

#If VBA7 Then ' 64-bit MS Office
    Private Declare PtrSafe Function sndPlaySound32bit Lib "winmm.dll" Alias "sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As LongPtr) As LongPtr
#Else ' 32-bit MS Office
    Private Declare Function sndPlaySound32bit Lib "winmm.dll" Alias "sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As LongPtr) As LongPtr
#End If


Public Sub PlaySound()
    sndPlaySound32bit "C:\Windows\Media\Speech On.wav", "&H1" ' should be &H1 (without double-quotes; see answer from @Gustav
End Sub

Upvotes: 1

Views: 2174

Answers (1)

Gustav
Gustav

Reputation: 55921

Your code works for me, but the last argument is not a string:

sndPlaySound32bit "C:\Windows\Media\Speech on.wav", &H1

This alternative method works also for me, though not for filenames with spaces:

StartSound "C:\Windows\Media\Alarm10.wav"

The code is a complete module:

Option Compare Text
Option Explicit

Private Declare PtrSafe Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" ( _
    ByVal lpstrCommand As String, _
    ByVal lpstrReturnString As Any, _
    ByVal uReturnLength As Long, _
    ByVal hwndCallback As Long) _
    As Long

Private Declare PtrSafe Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" ( _
    ByVal lpszLongPath As String, _
    ByVal lpszShortPath As String, _
    ByVal lBuffer As Long) _
    As Long
    
Private Const ErrorNone As Long = 0

Private CurrentFile     As String
Private PlayStatus      As Long

Public Sub StartSound(ByVal FileName As String)

    Const StartCommand  As String = "play"

    Dim AudioFileName   As String
    Dim Command         As String
    
    AudioFileName = GetShortPath(FileName)
    Command = StartCommand & " " & AudioFileName
    PlayStatus = mciSendString(Command, 0&, 0, 0)
    
    If PlayStatus = ErrorNone Then
        CurrentFile = AudioFileName
    End If

End Sub

Public Sub StopSound(Optional ByVal FileName As String)

    Const StopCommand   As String = "close"

    Dim AudioFileName   As String
    Dim Command         As String
    
    If FileName = "" Then
        AudioFileName = CurrentFile
    Else
        AudioFileName = GetShortPath(FileName)
    End If
    Command = StopCommand & " " & AudioFileName
    
    PlayStatus = mciSendString(Command, 0&, 0, 0)
    
End Sub

Public Function GetShortPath( _
    ByVal LongPath As String) _
    As String
    
    Dim Length  As Long
    Dim Buffer  As String
    Dim Path    As String
    
    ' Find buffer size.
    Length = GetShortPathName(LongPath, "", 0)
    If Length > 0 Then
        ' Create the buffer.
        Buffer = String(Length, vbNullChar)
        ' Retrieve the short path name.
        Length = GetShortPathName(LongPath, Buffer, Length)
        ' Remove the trailing null character.
        Path = Left(Buffer, Length)
    End If
    
    GetShortPath = Path
    
End Function

Upvotes: 2

Related Questions