API commands to turn volume control on

  • Thread starter Thread starter Mike
  • Start date Start date
M

Mike

Thanks in advance for your help.

Does anyone have some VBA code that will unmute the sound
for the Windows Volume control using Excel?

I read some stuff in Walkenbach's book about displaying
stuff from the Control Panel within Excel using windows
API calls but I didn't see anything about changing the
volume settings. Thanks again.
 
This toggles the mute control



On Error Resume Next
Set oShell = AppActivate("Volume control")
If oShell Is Nothing Then
Set oShell = CreateObject("WScript.Shell")
End If
oShell.run"Sndvol32"
WScript.Sleep 1500
oShell.SendKeys"{TAB 2} "


--

HTH

RP
(remove nothere from the email address if mailing direct)
 
Reading the current state of the 'Master Mute' checkbox
is a trifle complicated :( see Harald's link..

But in addition to Bob's solution of shelling to SndVol..
If you're working in Win2k/XP then Mute Toggling and VolumeUp and Down
can easily be done via the keyboard..

Option Explicit

Const VK_VOLUME_MUTE = &HAD 'Windows 2000/XP: Volume Mute key
Const VK_VOLUME_DOWN = &HAE 'Windows 2000/XP: Volume Down key
Const VK_VOLUME_UP = &HAF 'Windows 2000/XP: Volume Up key

Private Declare Sub keybd_event Lib "user32" ( _
ByVal bVk As Byte, ByVal bScan As Byte, _
ByVal dwFlags As Long, ByVal dwExtraInfo As Long)


Sub VolUp()
keybd_event VK_VOLUME_UP, 0, 1, 0
keybd_event VK_VOLUME_UP, 0, 3, 0
End Sub
Sub VolDown()
keybd_event VK_VOLUME_DOWN, 0, 1, 0
keybd_event VK_VOLUME_DOWN, 0, 3, 0
End Sub

Sub VolToggle()
keybd_event VK_VOLUME_MUTE, 0, 1, 0
End Sub







--
keepITcool
| www.XLsupport.com | keepITcool chello nl | amsterdam


Mike wrote :
 
gentlemenz...

Habeus Codum Per Volumum Mutum..

the ONLY thing following function does is tell you if
the MASTER Mute is ON or OFF

It will not look further than the master mute.If that is off, but the
Wave Mute is on... you still wont hear a thing.


pff... complicated what?!
adapted and compiled from various VB and C sources..

<G>


--
keepITcool
| www.XLsupport.com | keepITcool chello nl | amsterdam



Option Explicit

Const MMSYSERR_NOERROR = 0
Const MAXPNAMELEN = 32
Const MIXER_LONG_NAME_CHARS = 64
Const MIXER_SHORT_NAME_CHARS = 16

Const MIXER_OBJECTF_HANDLE As Long = &H80000000
Const MIXER_OBJECTF_MIXER As Long = &H0&
Const MIXER_OBJECTF_HMIXER As Long = ( _
MIXER_OBJECTF_HANDLE Or MIXER_OBJECTF_MIXER)

Const MIXER_GETLINEINFOF_COMPONENTTYPE = &H3&
Const MIXER_GETCONTROLDETAILSF_VALUE = &H0&
Const MIXER_GETLINECONTROLSF_ONEBYTYPE = &H2&
Const MIXERLINE_COMPONENTTYPE_DST_FIRST = &H0&
Const MIXERLINE_COMPONENTTYPE_DST_SPEAKERS = ( _
MIXERLINE_COMPONENTTYPE_DST_FIRST + 4)

Const MIXERCONTROL_CT_CLASS_SWITCH As Long = &H20000000
Const MIXERCONTROL_CT_SC_SWITCH_BOOLEAN As Long = &H0&
Const MIXERCONTROL_CT_UNITS_BOOLEAN As Long = &H10000
Const MIXERCONTROL_CONTROLTYPE_BOOLEAN As Long = ( _
MIXERCONTROL_CT_CLASS_SWITCH Or _
MIXERCONTROL_CT_SC_SWITCH_BOOLEAN Or _
MIXERCONTROL_CT_UNITS_BOOLEAN)
Const MIXERCONTROL_CONTROLTYPE_MUTE As Long = ( _
MIXERCONTROL_CONTROLTYPE_BOOLEAN + 2)


Declare Function mixerClose Lib "winmm.dll" ( _
ByVal hmx As Long) As Long
Declare Function mixerOpen Lib "winmm.dll" (phmx As Long, _
ByVal uMxId As Long, ByVal dwCallback As Long, _
ByVal dwInstance As Long, ByVal fdwOpen As Long) As Long

Declare Function mixerGetControlDetails Lib "winmm.dll" _
Alias "mixerGetControlDetailsA" (ByVal hmxobj As Long, _
pmxcd As MIXERCONTROLDETAILS, _
ByVal fdwDetails As Long) As Long
Declare Function mixerGetLineControls Lib "winmm.dll" Alias _
"mixerGetLineControlsA" (ByVal hmxobj As Long, _
pmxlc As MIXERLINECONTROLS, _
ByVal fdwControls As Long) As Long
Declare Function mixerGetLineInfo Lib "winmm.dll" Alias _
"mixerGetLineInfoA" (ByVal hmxobj As Long, _
pmxl As MIXERLINE, ByVal fdwInfo As Long) As Long


Declare Function GlobalAlloc Lib "kernel32" ( _
ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Declare Function GlobalLock Lib "kernel32" ( _
ByVal hMem As Long) As Long
Declare Function GlobalFree Lib "kernel32" ( _
ByVal hMem As Long) As Long
Declare Sub CopyStructFromPtr Lib "kernel32" Alias _
"RtlMoveMemory" (struct As Any, ByVal ptr As Long, _
ByVal cb As Long)
Declare Sub CopyPtrFromStruct Lib "kernel32" Alias _
"RtlMoveMemory" (ByVal ptr As Long, struct As Any, _
ByVal cb As Long)

Type MIXERCONTROL
cbStruct As Long
dwControlID As Long
dwControlType As Long
fdwControl As Long
cMultipleItems As Long
szShortName As String * MIXER_SHORT_NAME_CHARS
szName As String * MIXER_LONG_NAME_CHARS
lMinimum As Long
lMaximum As Long
reserved(10) As Long
End Type

Type MIXERCONTROLDETAILS
cbStruct As Long
dwControlID As Long
cChannels As Long
item As Long
cbDetails As Long
paDetails As Long
End Type

Type MIXERCONTROLDETAILS_BOOLEAN
dwValue As Long
End Type

Type MIXERLINE
cbStruct As Long
dwDestination As Long
dwSource As Long
dwLineID As Long
fdwLine As Long
dwUser As Long
dwComponentType As Long
cChannels As Long
cConnections As Long
cControls As Long
szShortName As String * MIXER_SHORT_NAME_CHARS
szName As String * MIXER_LONG_NAME_CHARS
dwType As Long
dwDeviceID As Long
wMid As Integer
wPid As Integer
vDriverVersion As Long
szPname As String * MAXPNAMELEN
End Type

Type MIXERLINECONTROLS
cbStruct As Long
dwLineID As Long
dwControl As Long
cControls As Long
cbmxctrl As Long
pamxctrl As Long
End Type

Function GetMasterMuteState() As Boolean
' This function reads the state of the masterMute control
Dim hMixer As Long ' mixer handle

Dim mxc As MIXERCONTROL
Dim mxl As MIXERLINE
Dim mxlc As MIXERLINECONTROLS
Dim mxcd As MIXERCONTROLDETAILS
Dim mxcdMute As MIXERCONTROLDETAILS_BOOLEAN

Dim hMem As Long
Dim rc As Long
Dim iErr As Integer

' Open the mixer with deviceID 0.
rc = mixerOpen(hMixer, 0, 0, 0, 0)
If ((MMSYSERR_NOERROR <> rc)) Then iErr = 1: GoTo theExit

mxl.cbStruct = Len(mxl)
mxl.dwComponentType = MIXERLINE_COMPONENTTYPE_DST_SPEAKERS

' Obtain a line corresponding to the component type
rc = mixerGetLineInfo(hMixer, mxl, _
MIXER_GETLINEINFOF_COMPONENTTYPE)
If (MMSYSERR_NOERROR <> rc) Then iErr = 2: GoTo theExit


mxlc.cbStruct = Len(mxlc)
mxlc.dwLineID = mxl.dwLineID
mxlc.dwControl = MIXERCONTROL_CONTROLTYPE_MUTE
mxlc.cControls = 1
mxlc.cbmxctrl = Len(mxc)

' Allocate a buffer for the control
hMem = GlobalAlloc(&H40, Len(mxc))
mxlc.pamxctrl = GlobalLock(hMem)
mxc.cbStruct = Len(mxc)

' Get the control
rc = mixerGetLineControls(hMixer, mxlc, _
MIXER_GETLINECONTROLSF_ONEBYTYPE)
If (MMSYSERR_NOERROR <> rc) Then iErr = 3: GoTo theExit
'Copy into mxc structure
CopyStructFromPtr mxc, mxlc.pamxctrl, Len(mxc)
GlobalFree (hMem)
hMem = 0

'Get the controldetails
mxcd.cbStruct = Len(mxcd)
mxcd.dwControlID = mxc.dwControlID
mxcd.cChannels = 1
mxcd.item = 0
mxcd.cbDetails = Len(mxcdMute)

' Allocate a buffer for the controldetails
hMem = GlobalAlloc(&H40, Len(mxcdMute))
mxcd.paDetails = GlobalLock(hMem)

'Get the controldetailvalue
rc = mixerGetControlDetails(hMixer, mxcd, _
MIXER_OBJECTF_HMIXER Or MIXER_GETCONTROLDETAILSF_VALUE)
If (MMSYSERR_NOERROR <> rc) Then iErr = 4: GoTo theExit
' Copy into mxcdMute structure
CopyStructFromPtr mxcdMute, mxcd.paDetails, Len(mxcdMute)
theExit:
If hMem Then GlobalFree (hMem)
If hMixer Then mixerClose (hMixer)

If iErr <> 0 Then
MsgBox "Couldn't read the Master Mute Control"
Else
GetMasterMuteState = CBool(mxcdMute.dwValue)
End If
End Function





keepITcool wrote :
 
harald,

FWIW:

hardly trimmed, but functional and
adapted to the Master Mute switch.

see other post in the thread.
<g>

--
keepITcool
| www.XLsupport.com | keepITcool chello nl | amsterdam


Harald Staff wrote :
 
Following will read AND update the mutecontrols.
it will look at both the MasterMute and the WaveMute

DONE!... A bit of work so I'd appreciate some reactions :)



Option Explicit

Private Const MMSYSERR_NOERROR As Long = 0
Private Const MAXPNAMELEN As Long = 32
Private Const MIXER_LONG_NAME_CHARS As Long = 64
Private Const MIXER_SHORT_NAME_CHARS As Long = 16

Private Const MIXER_OBJECTF_HANDLE As Long = &H80000000
Private Const MIXER_OBJECTF_MIXER As Long = &H0&
Private Const MIXER_OBJECTF_HMIXER As Long =
(MIXER_OBJECTF_HANDLE Or MIXER_OBJECTF_MIXER)

Private Const MIXER_GETLINEINFOF_COMPONENTTYPE As Long = &H3&
Private Const MIXER_GETCONTROLDETAILSF_VALUE As Long = &H0&
Private Const MIXER_SETCONTROLDETAILSF_VALUE As Long = &H0&


Private Const MIXER_GETLINECONTROLSF_ONEBYTYPE As Long = &H2&
Private Const MIXERLINE_COMPONENTTYPE_DST_FIRST As Long = &H0&
Private Const MIXERLINE_COMPONENTTYPE_DST_SPEAKERS As Long =
(MIXERLINE_COMPONENTTYPE_DST_FIRST + 4)


Private Const MIXERLINE_COMPONENTTYPE_DST_WAVEIN As Long =
(MIXERLINE_COMPONENTTYPE_DST_FIRST + 7)
Private Const MIXERLINE_COMPONENTTYPE_SRC_FIRST As Long = &H1000&
Private Const MIXERLINE_COMPONENTTYPE_SRC_WAVEOUT As Long =
(MIXERLINE_COMPONENTTYPE_SRC_FIRST + 8)

Private Const MIXERCONTROL_CT_CLASS_SWITCH As Long = &H20000000
Private Const MIXERCONTROL_CT_SC_SWITCH_BOOLEAN As Long = &H0&
Private Const MIXERCONTROL_CT_UNITS_BOOLEAN As Long = &H10000
Private Const MIXERCONTROL_CONTROLTYPE_BOOLEAN As Long =
(MIXERCONTROL_CT_CLASS_SWITCH Or MIXERCONTROL_CT_SC_SWITCH_BOOLEAN Or
MIXERCONTROL_CT_UNITS_BOOLEAN)
Private Const MIXERCONTROL_CONTROLTYPE_MUTE As Long =
(MIXERCONTROL_CONTROLTYPE_BOOLEAN + 2)


Private Declare Function mixerClose Lib "winmm.dll" (ByVal hmx As Long)
As Long
Private Declare Function mixerOpen Lib "winmm.dll" (phmx As Long, ByVal
uMxId As Long, ByVal dwCallback As Long, ByVal dwInstance As Long,
ByVal fdwOpen As Long) As Long

Private Declare Function mixerGetLineInfo Lib "winmm.dll" Alias
"mixerGetLineInfoA" (ByVal hmxobj As Long, pmxl As MIXERLINE, ByVal
fdwInfo As Long) As Long
Private Declare Function mixerGetLineControls Lib "winmm.dll" Alias
"mixerGetLineControlsA" (ByVal hmxobj As Long, pmxlc As
MIXERLINECONTROLS, ByVal fdwControls As Long) As Long
Private Declare Function mixerGetControlDetails Lib "winmm.dll" Alias
"mixerGetControlDetailsA" (ByVal hmxobj As Long, pmxcd As
MIXERCONTROLDETAILS, ByVal fdwDetails As Long) As Long
Private Declare Function mixerSetControlDetails Lib "winmm.dll" (ByVal
hmxobj As Long, ByRef pmxcd As MIXERCONTROLDETAILS, ByVal fdwDetails As
Long) As Long



Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As
Long, ByVal dwBytes As Long) As Long
Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long)
As Long
Private Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long)
As Long
Private Declare Sub CopyStructFromPtr Lib "kernel32" Alias
"RtlMoveMemory" (struct As Any, ByVal ptr As Long, ByVal cb As Long)
Private Declare Sub CopyPtrFromStruct Lib "kernel32" Alias
"RtlMoveMemory" (ByVal ptr As Long, struct As Any, ByVal cb As Long)
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory"
(pDst As Any, pSrc As Any, ByVal ByteLen As Long)

Type MIXERCONTROL
cbStruct As Long
dwControlID As Long
dwControlType As Long
fdwControl As Long
cMultipleItems As Long
szShortName As String *
MIXER_SHORT_NAME_CHARS
szName As String *
MIXER_LONG_NAME_CHARS
lMinimum As Long
lMaximum As Long
reserved(10) As Long
End Type

Type MIXERCONTROLDETAILS
cbStruct As Long
dwControlID As Long
cChannels As Long
item As Long
cbDetails As Long
paDetails As Long
End Type

Type MIXERCONTROLDETAILS_BOOLEAN
dwValue As Long
End Type

Type MIXERLINE
cbStruct As Long
dwDestination As Long
dwSource As Long
dwLineID As Long
fdwLine As Long
dwUser As Long
dwComponentType As Long
cChannels As Long
cConnections As Long
cControls As Long
szShortName As String *
MIXER_SHORT_NAME_CHARS
szName As String *
MIXER_LONG_NAME_CHARS
dwType As Long
dwDeviceID As Long
wMid As Integer
wPid As Integer
vDriverVersion As Long
szPname As String * MAXPNAMELEN
End Type

Type MIXERLINECONTROLS
cbStruct As Long
dwLineID As Long
dwControl As Long
cControls As Long
cbmxctrl As Long
pamxctrl As Long
End Type

Function MuteIT(Optional bChange As Boolean, Optional bState As
Boolean) As Boolean
' This function reads and optionally sets the state
' of the mastermute and wavemute controls

' For disabling mute BOTH mutes will be set to false.
' For enabling mute ONLY the master mute will be set

Dim hMixer As Long ' mixer handle
Dim hMem As Long ' memory handle
Dim rc As Long
Dim iErr As Integer
Dim iDev As Integer
Dim bMuted(1 To 2) As Boolean


' Open the mixer with deviceID 0.
rc = mixerOpen(hMixer, 0, 0, 0, 0)
If ((MMSYSERR_NOERROR <> rc)) Then iErr = 1: GoTo theExit

For iDev = 1 To 2
Dim mxc As MIXERCONTROL
Dim mxl As MIXERLINE
Dim mxlc As MIXERLINECONTROLS
Dim mxcd As MIXERCONTROLDETAILS
Dim mxcdMute As MIXERCONTROLDETAILS_BOOLEAN

mxl.cbStruct = Len(mxl)
Select Case iDev
Case 1: mxl.dwComponentType = MIXERLINE_COMPONENTTYPE_DST_SPEAKERS
'MasterMute
Case 2: mxl.dwComponentType = MIXERLINE_COMPONENTTYPE_SRC_WAVEOUT
'WaveMute
End Select

' Obtain a line corresponding to the component type
rc = mixerGetLineInfo(hMixer, mxl, _
MIXER_GETLINEINFOF_COMPONENTTYPE)
If (MMSYSERR_NOERROR <> rc) Then iErr = 2: GoTo theExit


mxlc.cbStruct = Len(mxlc)
mxlc.dwLineID = mxl.dwLineID
mxlc.dwControl = MIXERCONTROL_CONTROLTYPE_MUTE
mxlc.cControls = 1
mxlc.cbmxctrl = Len(mxc)

' Allocate a buffer for the control
hMem = GlobalAlloc(&H40, Len(mxc))
mxlc.pamxctrl = GlobalLock(hMem)
mxc.cbStruct = Len(mxc)

' Get the control
rc = mixerGetLineControls(hMixer, mxlc, _
MIXER_GETLINECONTROLSF_ONEBYTYPE)
If (MMSYSERR_NOERROR <> rc) Then iErr = 3: GoTo theExit
'Copy into mxc structure
CopyStructFromPtr mxc, mxlc.pamxctrl, Len(mxc)
GlobalFree (hMem): hMem = 0

'Get the controldetails
mxcd.cbStruct = Len(mxcd)
mxcd.dwControlID = mxc.dwControlID
mxcd.cChannels = 1
mxcd.item = 0
mxcd.cbDetails = Len(mxcdMute)

' Allocate a buffer for the controldetails
hMem = GlobalAlloc(&H40, Len(mxcdMute))
mxcd.paDetails = GlobalLock(hMem)

'Get the controldetailvalue
rc = mixerGetControlDetails(hMixer, mxcd, _
MIXER_OBJECTF_HMIXER Or MIXER_GETCONTROLDETAILSF_VALUE)
If (MMSYSERR_NOERROR <> rc) Then iErr = 4: GoTo theExit
' Copy into mxcdMute structure
CopyStructFromPtr mxcdMute, mxcd.paDetails, Len(mxcdMute)
GlobalFree (hMem): hMem = 0
bMuted(iDev) = CBool(mxcdMute.dwValue)

If bChange Then
If bMuted(iDev) <> bState Then

mxcdMute.dwValue = IIf(bState And iDev = 1, 1, 0)
CopyPtrFromStruct mxcd.paDetails, mxcdMute, Len(mxcdMute)

'update the mixercontrol
rc = mixerSetControlDetails(hMixer, mxcd, _
MIXER_OBJECTF_HMIXER Or MIXER_SETCONTROLDETAILSF_VALUE)

If (MMSYSERR_NOERROR <> rc) Then iErr = 5: GoTo theExit
bMuted(iDev) = CBool(mxcdMute.dwValue)
End If
End If

Next


theExit:
If hMem Then GlobalFree (hMem)
If hMixer Then mixerClose (hMixer)

If iErr <> 0 Then
MsgBox "Error in MuteIt" & vbLf & _
"exit code:" & iErr & "Device:" & iDev
Else
MuteIT = (bMuted(1) Or bMuted(2))
End If
End Function






--
keepITcool
| www.XLsupport.com | keepITcool chello nl | amsterdam


Mike wrote :
 
DONE!... A bit of work so I'd appreciate some reactions :)
Click to expand...

First reaction: Impressed, and a great thing to have in the archives.
It's pretty huge though, so a qualified piece of insight reaction kind of
thing will not happen the first few days ;-)

Best wishes Harald
 
Hi KeepITcool

some reaction - looks like amazing code !

The good news -
it successfully muted the volume

The bad news -
it successfully crashed my Excel and removed the volume controls from system
tray. Lots of fumes and smoke coming from the back my pc, or perhaps from
the back of my head, difficult to tell.

Had to reboot twice to get the volume controls back to tray. XL2K - W98/2

Possible reason - once before I tried some seriously good stuff from this ng
which crashed in a big way. Reason was due to me not unwrapping all lines
correctly, even though I thought I carefully had. Pretty sure I unwrapped
yours correctly, when I have time and am "prepared" will try again and step
through.

Regards,
Peter T
 
I've written/tested xlXP/2003 and WinXP.

While testing:
first test with bChange omitted or FALSE.

I think I need to look at memorylocking when I copy the changed
structure back. That may be the cause of crashing.

Cant test w98. But will check documentation for the apis
for w98 compatibility.



--
keepITcool
| www.XLsupport.com | keepITcool chello nl | amsterdam


Peter T wrote :
 
Peter,

documentation says:
NT 3.1 or later; Windows 95 or later

however I've added memory locking in the change part.
let me know if it stops the crashing.

I can toggle the mute 1000 times and it works ok for me.


please swap the
If bChange..EndIf block at the bottom of the loop

to:

If bChange Then
If bMuted(iDev) <> bState Then

mxcdMute.dwValue = IIf(bState And iDev = 1, 1, 0)
hMem = GlobalAlloc(&H40, Len(mxcdMute))
mxcd.paDetails = GlobalLock(hMem)

CopyPtrFromStruct mxcd.paDetails, mxcdMute, Len(mxcdMute)

'update the mixercontrol
rc = mixerSetControlDetails(hMixer, mxcd, _
MIXER_OBJECTF_HMIXER Or MIXER_SETCONTROLDETAILSF_VALUE)

If (MMSYSERR_NOERROR <> rc) Then iErr = 5: GoTo theExit
GlobalFree (hMem): hMem = 0

bMuted(iDev) = CBool(mxcdMute.dwValue)
End If
End If





--
keepITcool
| www.XLsupport.com | keepITcool chello nl | amsterdam


keepITcool wrote :
 
I should have mentioned - first time I tried was simply:

b = MuteIT

which returned False and made no changes to Vol/mute.
Then I tried following which resulted in the crash:

b = MuteIT(true, true)

FWIW I had successfully compiled the code with Option Explicit at top of the
module.

Regards,
Peter T
 
OK, the amended code works!

bChange True/False does not appear to make any change to any of the mute
settings, regardless of the state I pass bState. However changing bState
turns the master mute on/off.

With a deep breath I commented the amended & un-commented the original,
stepped through very slowly and crashed on this:

If bChange Then
'##########
CopyPtrFromStruct mxcd.paDetails, mxcdMute, Len(mxcdMute)
'##########
End If

got a nice message telling me to contact the vendor !

This time it didn't remove the vol control from system tray, maybe because I
was stepping through.

Regards,
Peter T
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Excel Macro to un-mute Audio/speakers. 15
Sound Volume control 1
Windows 10 Insufficient disk space to fix volume bitmap. 5
Windows XP lost file Sndvol32.exe (volume control) 11
Line-in to sound card - no sound, no volume display 3
VOLUME CONTROL 1
Windows API 4
Help - Volume control 2

Back
Top