# VBA code to turn volume on, up, down



## Kerry Newman

I am trying to find some code to turn my speaker volume on, up or down. 
I am using the Speak function if that has any relevance...... thanks!


----------



## Jaafar Tribak

https://wellsr.com/vba/2016/excel/use-vba-to-mute-unmute-volume-up-volume-down/


----------



## Kerry Newman

Jaafar Tribak said:


> https://wellsr.com/vba/2016/excel/use-vba-to-mute-unmute-volume-up-volume-down/



Thanks Jaafar,
I have played around with the code on this site, never got it to work....


----------



## Jaafar Tribak

Do you get any errors ? Are you running a Mac or a PC  ? if Windows , which version ?


----------



## Kerry Newman

Jaafar Tribak said:


> Do you get any errors ? Are you running a Mac or a PC  ? if Windows , which version ?



I am on a PC using Windows 10 I think, Excel 2016...


----------



## pvr928

You have to call the relevant routine from another sub. For example (as Wellsr demonstrates (and by the way, he is a genius!)), to turn the volume up, use this code:



		Code:
__


Sub Turn_Volume_UP

Call VolUp

End Sub


Add this to a Command Button, and your volume will increase. Do something similar for decreasing volume, and muting.

I'm using Office 365 32bit and Windows 10. His code works for me.

Have fun.

Cheers

pvr928


----------



## Kerry Newman

pvr928 said:


> You have to call the relevant routine from another sub. For example (as Wellsr demonstrates (and by the way, he is a genius!)), to turn the volume up, use this code:
> 
> 
> 
> Code:
> __
> 
> 
> Sub Turn_Volume_UP
> 
> Call VolUp
> 
> End Sub
> 
> 
> Add this to a Command Button, and your volume will increase. Do something similar for decreasing volume, and muting.
> 
> I'm using Office 365 32bit and Windows 10. His code works for me.
> 
> Have fun.
> 
> Cheers
> 
> pvr928



Thanks,
I'll try that....


----------



## StanStrong

Kerry Newman said:


> I am trying to find some code to turn my speaker volume on, up or down.
> I am using the Speak function if that has any relevance...... thanks!


Really, Really hard to find a way - I was even trying to adjust external amps with 0-10V via USB!
I found this:
View / change sound volume on Windows 11/10/7/8/2008 from command-line or GUI
I got the zip file and copied the files to C:\  just to be handy.
Then I had to find out how to run a ".exe" from VBA.
This worked:
  ("Realtek High Definition Audio" is the "Friendly name" from looking at SoundVolumeView.exe in Windows.)
  (I don't know where these .wav files are from , but Freesound - sound search has many)
'========================================= Sound Balance TEST
    Shell "C:\SoundVolumeView.exe /SetVolumeChannels ""Realtek High Definition Audio\Device\Speakers\Render"" 24 62", vbNormalFocus
    Call PlaySound(Application.ActiveWorkbook.Path & "\ringin.wav", 0, SND_SYNC Or SND_FILENAME Or SND_NOSTOP)
    Shell "C:\SoundVolumeView.exe /SetVolumeChannels ""Realtek High Definition Audio\Device\Speakers\Render"" 62 24", vbNormalFocus
    Call PlaySound(Application.ActiveWorkbook.Path & "\ringin.wav", 0, SND_SYNC Or SND_FILENAME Or SND_NOSTOP)

    Shell "C:\SoundVolumeView.exe /SetVolumeChannels ""Realtek High Definition Audio\Device\Speakers\Render"" 24 62", vbNormalFocus
    Call PlaySound(Application.ActiveWorkbook.Path & "\blip.wav", 0, SND_SYNC Or SND_FILENAME Or SND_NOSTOP)
    Shell "C:\SoundVolumeView.exe /SetVolumeChannels ""Realtek High Definition Audio\Device\Speakers\Render"" 62 24", vbNormalFocus
    Call PlaySound(Application.ActiveWorkbook.Path & "\blip.wav", 0, SND_SYNC Or SND_FILENAME Or SND_NOSTOP)

    Shell "C:\SoundVolumeView.exe /SetVolumeChannels ""Realtek High Definition Audio\Device\Speakers\Render"" 21 21", vbNormalFocus
    Call PlaySound(Application.ActiveWorkbook.Path & "\ringin.wav", 0, SND_SYNC Or SND_FILENAME Or SND_NOSTOP)
    Call PlaySound(Application.ActiveWorkbook.Path & "\blip.wav", 0, SND_SYNC Or SND_FILENAME Or SND_NOSTOP)
    Call PlaySound(Application.ActiveWorkbook.Path & "\testsnd.wav", 0, SND_SYNC Or SND_FILENAME Or SND_NOSTOP)
'========================================= Sound Balance TEST


----------



## Jaafar Tribak

Try this  alternative :


		VBA Code:
__


Option Explicit

#If Win64 Then
    Private Const NULL_PTR = 0^
#Else
    Private Const NULL_PTR = 0&
#End If

#If VBA7 Then
    Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageW" (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr
#Else
    Private Declare Function SendMessage Lib "user32" Alias "SendMessageW" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
#End If

Private Const APPCOMMAND_VOLUME_MUTE As Long = &H80000
Private Const APPCOMMAND_VOLUME_UP As Long = &HA0000
Private Const APPCOMMAND_VOLUME_DOWN As Long = &H90000
Private Const WM_APPCOMMAND As Long = &H319
 
 
Sub ToggleMute()
    Call SendMessage(Application.hwnd, WM_APPCOMMAND, NULL_PTR, ByVal APPCOMMAND_VOLUME_MUTE)
End Sub

Sub DecreaseVol()
    Call SendMessage(Application.hwnd, WM_APPCOMMAND, NULL_PTR, ByVal APPCOMMAND_VOLUME_DOWN)
End Sub

Sub IncreaseVol()
    Call SendMessage(Application.hwnd, WM_APPCOMMAND, NULL_PTR, ByVal APPCOMMAND_VOLUME_UP)
End Sub



Note that this is also a keyboard based workaround that may not work with certain keyboards.
I believe the propper way of doing this in vista or higher is via the core audio interfaces


----------



## StanStrong

Jaafar Tribak said:


> Try this  alternative :
> 
> 
> VBA Code:
> __
> 
> 
> Option Explicit
> 
> #If Win64 Then
> Private Const NULL_PTR = 0^
> #Else
> Private Const NULL_PTR = 0&
> #End If
> 
> #If VBA7 Then
> Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageW" (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr
> #Else
> Private Declare Function SendMessage Lib "user32" Alias "SendMessageW" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
> #End If
> 
> Private Const APPCOMMAND_VOLUME_MUTE As Long = &H80000
> Private Const APPCOMMAND_VOLUME_UP As Long = &HA0000
> Private Const APPCOMMAND_VOLUME_DOWN As Long = &H90000
> Private Const WM_APPCOMMAND As Long = &H319
> 
> 
> Sub ToggleMute()
> Call SendMessage(Application.hwnd, WM_APPCOMMAND, NULL_PTR, ByVal APPCOMMAND_VOLUME_MUTE)
> End Sub
> 
> Sub DecreaseVol()
> Call SendMessage(Application.hwnd, WM_APPCOMMAND, NULL_PTR, ByVal APPCOMMAND_VOLUME_DOWN)
> End Sub
> 
> Sub IncreaseVol()
> Call SendMessage(Application.hwnd, WM_APPCOMMAND, NULL_PTR, ByVal APPCOMMAND_VOLUME_UP)
> End Sub
> 
> 
> 
> Note that this is also a keyboard based workaround that may not work with certain keyboards.
> I believe the propper way of doing this in vista or higher is via the core audio interfaces


Thanks! I wanted to set both Left and Right so that I could adjust the balance.  Like: *APPCOMMAND_VOLUME_SET_LEFT_RIGHT.*
I was so excited to find "SoundVolumeView" - they found what actually works. I used their command line version in the end.


----------



## Kerry Newman

I am trying to find some code to turn my speaker volume on, up or down. 
I am using the Speak function if that has any relevance...... thanks!


----------



## Jaafar Tribak

StanStrong said:


> Thanks! I wanted to set both Left and Right so that I could adjust the balance.  Like: *APPCOMMAND_VOLUME_SET_LEFT_RIGHT.*
> I was so excited to find "SoundVolumeView" - they found what actually works. I used their command line version in the end.


Thanks for the feedabck and happy you found a solution.


----------



## Jaafar Tribak

In case anyone is looking for an answer in the future, here is a solution for muting, umuting, setting and reading the volume of the system default audio. This approach works in Windows Vista or higher w/o relying on unreliable keyboard strokes.

*Workbook Demo*: CoreAudio.xlsm

The code doesn't depend on any external exes or typelibs...  The code is entirely based on plain vba and a few low-level VTable calls @runtime on the IMMDeviceEnumerator, IMMDevice and IAudioEndpointVolume Interfaces.








*1*- Class Module : *CAudio*


		VBA Code:
__


Option Explicit

Private Enum VOL_ACTION
    ºSetVol
    ºGetVol
    ºMute
    ºUnMute
    ºIsMuteState
End Enum

#If Win64 Then
    Private Const NULL_PTR = 0^
    Private Const PTR_SIZE = 8&
#Else
    Private Const NULL_PTR = 0&
    Private Const PTR_SIZE = 4&
#End If

Private Type GUID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(0& To 7&) As Byte
End Type

#If VBA7 Then
    Private Declare PtrSafe Sub SetLastError Lib "Kernel32.dll" (ByVal dwErrCode As Long)
    Private Declare PtrSafe Function DispCallFunc Lib "OleAut32.dll" (ByVal pvInstance As LongPtr, ByVal offsetinVft As LongPtr, ByVal CallConv As Long, ByVal retTYP As Integer, ByVal paCNT As Long, ByRef paTypes As Integer, ByRef paValues As LongPtr, ByRef retVAR As Variant) As Long
    Private Declare PtrSafe Function IIDFromString Lib "ole32.dll" (ByVal lpsz As LongPtr, ByRef lpiid As Any) As Long
    Private Declare PtrSafe Function CoCreateInstance Lib "ole32" (ByRef rclsid As GUID, ByVal pUnkOuter As LongPtr, ByVal dwClsContext As Long, ByRef riid As GUID, ByRef ppv As LongPtr) As Long
    Private Declare PtrSafe Function CLSIDFromString Lib "ole32" (ByVal OleStringCLSID As LongPtr, ByRef cGUID As Any) As Long
#Else
    Private Enum LongPtr
        [_]
    End Enum
    Private Declare Sub SetLastError Lib "Kernel32.dll" (ByVal dwErrCode As Long)
    Private Declare Function DispCallFunc Lib "OleAut32.dll" (ByVal pvInstance As LongPtr, ByVal offsetinVft As LongPtr, ByVal CallConv As Long, ByVal retTYP As Integer, ByVal paCNT As Long, ByRef paTypes As Integer, ByRef paValues As LongPtr, ByRef retVAR As Variant) As Long
    Private Declare Function IIDFromString Lib "ole32.dll" (ByVal lpsz As LongPtr, ByRef lpiid As Any) As Long
    Private Declare Function CoCreateInstance Lib "ole32" (ByRef rclsid As GUID, ByVal pUnkOuter As LongPtr, ByVal dwClsContext As Long, ByRef riid As GUID, ByRef ppv As LongPtr) As Long
    Private Declare Function CLSIDFromString Lib "ole32" (ByVal OleStringCLSID As LongPtr, ByRef cGUID As Any) As Long
#End If


' _________________________________________PUBLIC CLASS METHODS _____________________________________

Public Sub Mute(Optional ByVal bMute As Boolean = True)
    If bMute Then
        Audio ºMute
    Else
        Audio ºUnMute
    End If
End Sub

Public Sub SeVol(ByVal VolLevel As Single)
    Audio ºSetVol, VolLevel
End Sub

Public Function GetVol() As Single
    GetVol = Audio(ºGetVol)
End Function

Public Function IsMuteState() As Boolean
    IsMuteState = Audio(ºIsMuteState)
End Function



' _________________________________________PRIVATE HELPER ROUTINES _____________________________________

Private Function Audio(eAction As VOL_ACTION, Optional VolLevel As Single = -1&) As Single

    Const CLSID_MMDeviceEnumerator = "{BCDE0395-E52F-467C-8E3D-C4579291692E}"
    Const IID_IMMDeviceEnumerator = "{A95664D2-9614-4F35-A746-DE8DB63617E6}"
    Const IID_IAudioEndpointVolume = "{5CDF2C82-841E-4546-9722-0CF74078229A}"
    Const IID_NULL = "{00000000-0000-0000-0000-000000000000}"
    Const CLSCTX_INPROC_SERVER = 1&
    Const CC_STDCALL = 4&
   
    Dim tClsID As GUID, tIID As GUID
    Dim pDeviceEnumerator As LongPtr, pdefaultDevice As LongPtr, pIAudioEndpointVolume As LongPtr
    Dim eRender As Long, eMultimedia As Long
    Dim lRet As Long
   
    If VolLevel <> -1& Then
        If VolLevel < 0& Or VolLevel > 1& Then
            MsgBox "Audio-tapered value must be in the range from 0.0 to 1.0"
            Exit Function
        End If
    End If

    lRet = CLSIDFromString(StrPtr(CLSID_MMDeviceEnumerator), tClsID)
    lRet = IIDFromString(StrPtr(IID_IMMDeviceEnumerator), tIID)

    'Create an enumerator for the audio endpoint devices
    lRet = CoCreateInstance(tClsID, NULL_PTR, CLSCTX_INPROC_SERVER, tIID, pDeviceEnumerator)
    If lRet Then MsgBox "Failed to get IMMDeviceEnumerator.": Exit Function
 
    eRender = 0&: eMultimedia = 1&
    'IMMDeviceEnumerator::GetDefaultAudioEndpoint Method.
    lRet = vtblCall(pDeviceEnumerator, 4& * PTR_SIZE, vbLong, CC_STDCALL, eRender, eMultimedia, VarPtr(pdefaultDevice))
    If lRet Then MsgBox "Failed to get IMMDevice.": Exit Function
 
    lRet = IIDFromString(StrPtr(IID_IAudioEndpointVolume), tIID)
    'IMMDevice::Activate Method.
    lRet = vtblCall(pdefaultDevice, 3& * PTR_SIZE, vbLong, CC_STDCALL, VarPtr(tIID), CLSCTX_INPROC_SERVER, 0&, VarPtr(pIAudioEndpointVolume))
    If lRet Then MsgBox "Failed to get IAudioEndpointVolume.": Exit Function

    lRet = IIDFromString(StrPtr(IID_NULL), tIID)
   
    Select Case eAction
        Case ºMute
            'IAudioEndpointVolume::SetMute Method.(True)
            lRet = vtblCall(pIAudioEndpointVolume, 14& * PTR_SIZE, vbLong, CC_STDCALL, 1&, VarPtr(tIID))
        Case ºUnMute
            'IAudioEndpointVolume::SetMute Method. (False)
            lRet = vtblCall(pIAudioEndpointVolume, 14& * PTR_SIZE, vbLong, CC_STDCALL, 0&, VarPtr(tIID))
        Case ºSetVol
            'IAudioEndpointVolume::SetMasterVolumeLevelScalar Method.
            lRet = vtblCall(pIAudioEndpointVolume, 7& * PTR_SIZE, vbLong, CC_STDCALL, CSng(VolLevel), VarPtr(tIID))
        Case ºGetVol
            'IAudioEndpointVolume::GetMasterVolumeLevelScalar Method.
            lRet = vtblCall(pIAudioEndpointVolume, 9& * PTR_SIZE, vbLong, CC_STDCALL, VarPtr(Audio))
        Case ºIsMuteState
            'IAudioEndpointVolume::GetMute Method.
            lRet = vtblCall(pIAudioEndpointVolume, 15& * PTR_SIZE, vbLong, CC_STDCALL, VarPtr(Audio))
    End Select
 
    'Release Interfaces.
    lRet = vtblCall(pIAudioEndpointVolume, 2& * PTR_SIZE, vbLong, CC_STDCALL)
    lRet = vtblCall(pdefaultDevice, 2& * PTR_SIZE, vbLong, CC_STDCALL)
    lRet = vtblCall(pDeviceEnumerator, 2& * PTR_SIZE, vbLong, CC_STDCALL)

End Function


Private Function vtblCall(ByVal InterfacePointer As LongPtr, ByVal VTableOffset As Long, ByVal FunctionReturnType As Long, ByVal CallConvention As Long, ParamArray FunctionParameters() As Variant) As Variant

    Dim vParamPtr() As LongPtr

    If InterfacePointer = 0& Or VTableOffset < 0& Then Exit Function
    If Not (FunctionReturnType And &HFFFF0000) = 0& Then Exit Function

    Dim pIndex As Long, pCount As Long
    Dim vParamType() As Integer
    Dim vRtn As Variant, vParams() As Variant

    vParams() = FunctionParameters()
    pCount = Abs(UBound(vParams) - LBound(vParams) + 1&)
    If pCount = 0& Then
        ReDim vParamPtr(0& To 0&)
        ReDim vParamType(0& To 0&)
    Else
        ReDim vParamPtr(0& To pCount - 1&)
        ReDim vParamType(0& To pCount - 1&)
        For pIndex = 0& To pCount - 1&
            vParamPtr(pIndex) = VarPtr(vParams(pIndex))
            vParamType(pIndex) = VarType(vParams(pIndex))
        Next
    End If

    pIndex = DispCallFunc(InterfacePointer, VTableOffset, CallConvention, FunctionReturnType, pCount, _
    vParamType(0&), vParamPtr(0&), vRtn)
    If pIndex = 0& Then
        vtblCall = vRtn
    Else
        SetLastError pIndex
    End If

End Function




*2*- *Code Usage example* ( UserFormm Module )


		VBA Code:
__


Option Explicit

Private oAudio As CAudio

Private Sub UserForm_Initialize()
    Set oAudio = New CAudio
    ScrollBar1.Min = 0
    ScrollBar1.Max = 100
    ScrollBar1.value = oAudio.GetVol * 100&
    CheckBox1.value = oAudio.IsMuteState
    Label1.Caption = "Vol:  [ " & oAudio.GetVol * 100 & " ]"
End Sub

Private Sub UserForm_Terminate()
    Set oAudio = Nothing
End Sub

Private Sub CheckBox1_Change()
    oAudio.Mute CheckBox1.value
End Sub

Private Sub ScrollBar1_Change()
    oAudio.SeVol ScrollBar1.value / 100&
    Label1.Caption = "Vol:  [ " & oAudio.GetVol * 100 & " ]"
End Sub

Private Sub ScrollBar1_Scroll()
    oAudio.SeVol ScrollBar1.value / 100&
    Label1.Caption = "Vol:  [ " & oAudio.GetVol * 100 & " ]"
End Sub


----------



## Ruddles

Umm... wow... where do I start?!

First of all, thank you for this.  I was obviously not using the correct keywords when doing my searches.  I've loaded that code into a workbook and it didn't like *Private Enum LongPtr [_] End Enum*.  I'm guessing this is for backward compatibility with older versions of VBA?  In any case, it was happier with that enumeration removed.

I got the userform working - that was (relatively, for me) - easy, and after some wrangling I managed to incorporate *.SeVol*, *.GetVol*, *.Mute*, *.UnMute *and .*IsMuteState *into my own code.

So thank you.  I would never have come up with anything like that on my own.  In fact, I don't understand most of it!

Best wishes from a very rainy West Country (of England).


----------



## Jaafar Tribak

@Ruddles


> I've loaded that code into a workbook and it didn't like *Private Enum LongPtr [_] End Enum*. I'm guessing this is for backward compatibility with older versions of VBA?


Yes, that's there for office 2007 or earlier but you can just ignore it and leave it as is as it won't compile in later versions.

Glad you got it working and thanks for the feedback.


----------



## panesrubrics

StanStrong said:


> Thanks! I wanted to set both Left and Right so that I could adjust the balance.  Like: *APPCOMMAND_VOLUME_SET_LEFT_RIGHT.*
> I was so excited to find "SoundVolumeView" - they found what actually works. I used their command line version in the end.


Thanks, this alleviate me from installing App which I don't mind paying but after 
(1) experiencing the hassle of reinstall after a PC reset which requires downloading of Apps or use a Paid Backup Tool
(2) feeling Web is becoming more important  me prefer an Edge Extension.

Unfortunately, there is no Edge Extension for this and so I am using VBA while waiting.

What I need is a choice of 3 Audio Volume Setting: 60%, 70%, 80% Is it possible ?


----------



## Jaafar Tribak

panesrubrics said:


> What I need is a choice of 3 Audio Volume Setting: 60%, 70%, 80% Is it possible ?


Have you tried uing the *CAudio* Class I posted in post#12 ?

Something like this should set the system volume to 60% :

oAudio.SeVol 0.6

Hope this helps.


----------

