Search code examples
vbaplayback

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

Solution

  • 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