Ещё бы желательно получать и устанавливать громкость

Option Explicit
' mixer API prototypes
Private Declare Function mixerGetNumDevs Lib "winmm.dll" () As Long
Private Declare Function mixerGetDevCaps Lib "winmm.dll" Alias "mixerGetDevCapsA" (ByVal uMxId As Long, pmxcaps As MIXERCAPS, ByVal cbmxcaps 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 mixerClose Lib "winmm.dll" (ByVal hmx 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, pmxcd As MIXERCONTROLDETAILS, ByVal fdwDetails As Long) As Long

' misc API prototypes
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 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 Type MIXERLINE
     cbStruct           As Long             ' size of MIXERLINE structure
     dwDestination      As Long             ' zero based destination index
     dwSource           As Long             ' zero based source index (if source)
     dwLineID           As Long             ' unique line id for mixer device
     fdwLine            As Long             ' state/information about line
     dwUser             As Long             ' driver specific information
     dwComponentType    As Long             ' component type line connects to
     cChannels          As Long             ' number of channels line supports
     cConnections       As Long             ' number of connections (possible)
     cControls          As Long             ' number of controls at this line
     szShortName        As String * &H10
     szName             As String * &H40
     dwType             As Long
     dwDeviceID         As Long
     wMid               As Integer
     wPid               As Integer
     vDriverVersion     As Long
     szPname            As String * &H20
End Type
Private Type MIXERCONTROL
     cbStruct           As Long             ' size in Byte of MIXERCONTROL
     dwControlID        As Long             ' unique control id for mixer device
     dwControlType      As Long             ' MIXERCONTROL_CONTROLTYPE_xxx
     fdwControl         As Long             ' MIXERCONTROL_CONTROLF_xxx
     cMultipleItems     As Long             ' if MIXERCONTROL_CONTROLF_MULTIPLE set
     szShortName        As String * &H10    ' short name of control
     szName             As String * &H40    ' long name of control
     lMinimum           As Long             ' Minimum value
     lMaximum           As Long             ' Maximum value
     reserved(10)       As Long             ' reserved structure space
End Type
Private Type MIXERLINECONTROLS
    cbStruct            As Long             '  size in Byte of MIXERLINECONTROLS
    dwLineID            As Long             '  line id (from MIXERLINE.dwLineID)
                                            '  MIXER_GETLINECONTROLSF_ONEBYID or
    dwControl           As Long             '  MIXER_GETLINECONTROLSF_ONEBYPrivate Type
    cControls           As Long             '  count of controls pmxctrl points to
    cbmxctrl            As Long             '  size in Byte of _one_ MIXERCONTROL
    pamxctrl            As Long             '  pointer to first MIXERCONTROL array
End Type
Private Type MIXERCONTROLDETAILS
     cbStruct           As Long             ' size in Byte of MIXERCONTROLDETAILS
     dwControlID        As Long             ' control id to get/set details on
     cChannels          As Long             ' number of channels in paDetails array
     item               As Long             ' hwndOwner or cMultipleItems
     cbDetails          As Long             ' size of _one_ details_XX struct
     paDetails          As Long             ' pointer to array of details_XX structs
End Type
Private Type MIXERCAPS
    wMid                As Integer          ' manufacturer id
    wPid                As Integer          ' product id
    vDriverVersion      As Long             ' version of the driver
    szPname             As String * &H20    ' product name
    fdwSupport          As Long             ' misc. support bits
    cDestinations       As Long             ' count of destinations
End Type

Public Enum VOL_CONTROL                     ' Для массива
    SPEAKER = 0
    LINEIN = 1
    MICROPHONE = 2
    SYNTHESIZER = 3
    COMPACTDISC = 4
    WAVEOUT = 5
    TELEPHONE = 6
    UNDEFINED = 7
End Enum
Public Enum MUTE_CONTROL
    SPEAKER_MUTE = 8
    LINEIN_MUTE = 9
    MICROPHONE_MUTE = 10
    SYNTHESIZER_MUTE = 11
    COMPACTDISC_MUTE = 12
    WAVEOUT_MUTE = 13
    TELEPHONE_MUTE = 14
    UNDEFINED_MUTE = 15
End Enum

Private Const MIXERLINE_COMPONENTTYPE_DST_SPEAKERS      As Long = &H4
Private Const MIXERLINE_COMPONENTTYPE_SRC_UNDEFINED     As Long = &H1000&
Private Const MIXERLINE_COMPONENTTYPE_SRC_LINE          As Long = &H1002&
Private Const MIXERLINE_COMPONENTTYPE_SRC_MICROPHONE    As Long = &H1003&
Private Const MIXERLINE_COMPONENTTYPE_SRC_SYNTHESIZER   As Long = &H1004&
Private Const MIXERLINE_COMPONENTTYPE_SRC_COMPACTDISC   As Long = &H1005&
Private Const MIXERLINE_COMPONENTTYPE_SRC_TELEPHONE     As Long = &H1006&
Private Const MIXERLINE_COMPONENTTYPE_SRC_WAVEOUT       As Long = &H1008&

Private Const MIXER_GETLINEINFOF_COMPONENTTYPE          As Long = &H3&

Private Const MIXERCONTROL_CONTROLTYPE_VOLUME           As Long = &H50030001
Private Const MIXERCONTROL_CONTROLTYPE_MUTE             As Long = &H20010002

Private Const MIXER_GETLINECONTROLSF_ONEBYTYPE          As Long = &H2&

Private Const MMSYSERR_NOERROR                          As Long = 0&

Private uMixerControls(15)      As MIXERCONTROL ' Массив для параметров микшера
Private hMixerHandle            As Long         ' Текущию микшер

Public Function OpenMixer(ByVal MixerNumber As Long) As Boolean
    If MixerNumber < 0 Or MixerNumber > mixerGetNumDevs - 1& Then Exit Function
    If Not mixerOpen(hMixerHandle, MixerNumber, 0, 0, 0) = MMSYSERR_NOERROR Then Exit Function

    ' Звук
    Call GetMixerControl(hMixerHandle, MIXERLINE_COMPONENTTYPE_DST_SPEAKERS, MIXERCONTROL_CONTROLTYPE_VOLUME, uMixerControls(SPEAKER))
    Call GetMixerControl(hMixerHandle, MIXERLINE_COMPONENTTYPE_SRC_LINE, MIXERCONTROL_CONTROLTYPE_VOLUME, uMixerControls(LINEIN))
    Call GetMixerControl(hMixerHandle, MIXERLINE_COMPONENTTYPE_SRC_MICROPHONE, MIXERCONTROL_CONTROLTYPE_VOLUME, uMixerControls(MICROPHONE))
    Call GetMixerControl(hMixerHandle, MIXERLINE_COMPONENTTYPE_SRC_SYNTHESIZER, MIXERCONTROL_CONTROLTYPE_VOLUME, uMixerControls(SYNTHESIZER))
    Call GetMixerControl(hMixerHandle, MIXERLINE_COMPONENTTYPE_SRC_COMPACTDISC, MIXERCONTROL_CONTROLTYPE_VOLUME, uMixerControls(COMPACTDISC))
    Call GetMixerControl(hMixerHandle, MIXERLINE_COMPONENTTYPE_SRC_WAVEOUT, MIXERCONTROL_CONTROLTYPE_VOLUME, uMixerControls(WAVEOUT))
    Call GetMixerControl(hMixerHandle, MIXERLINE_COMPONENTTYPE_SRC_TELEPHONE, MIXERCONTROL_CONTROLTYPE_VOLUME, uMixerControls(TELEPHONE))
    Call GetMixerControl(hMixerHandle, MIXERLINE_COMPONENTTYPE_SRC_UNDEFINED, MIXERCONTROL_CONTROLTYPE_VOLUME, uMixerControls(UNDEFINED))

    ' Режим - mute
    Call GetMixerControl(hMixerHandle, MIXERLINE_COMPONENTTYPE_DST_SPEAKERS, MIXERCONTROL_CONTROLTYPE_MUTE, uMixerControls(SPEAKER_MUTE))
    Call GetMixerControl(hMixerHandle, MIXERLINE_COMPONENTTYPE_SRC_LINE, MIXERCONTROL_CONTROLTYPE_MUTE, uMixerControls(LINEIN_MUTE))
    Call GetMixerControl(hMixerHandle, MIXERLINE_COMPONENTTYPE_SRC_MICROPHONE, MIXERCONTROL_CONTROLTYPE_MUTE, uMixerControls(MICROPHONE_MUTE))
    Call GetMixerControl(hMixerHandle, MIXERLINE_COMPONENTTYPE_SRC_SYNTHESIZER, MIXERCONTROL_CONTROLTYPE_MUTE, uMixerControls(SYNTHESIZER_MUTE))
    Call GetMixerControl(hMixerHandle, MIXERLINE_COMPONENTTYPE_SRC_COMPACTDISC, MIXERCONTROL_CONTROLTYPE_MUTE, uMixerControls(COMPACTDISC_MUTE))
    Call GetMixerControl(hMixerHandle, MIXERLINE_COMPONENTTYPE_SRC_WAVEOUT, MIXERCONTROL_CONTROLTYPE_MUTE, uMixerControls(WAVEOUT_MUTE))
    Call GetMixerControl(hMixerHandle, MIXERLINE_COMPONENTTYPE_SRC_TELEPHONE, MIXERCONTROL_CONTROLTYPE_MUTE, uMixerControls(TELEPHONE_MUTE))
    Call GetMixerControl(hMixerHandle, MIXERLINE_COMPONENTTYPE_SRC_UNDEFINED, MIXERCONTROL_CONTROLTYPE_MUTE, uMixerControls(UNDEFINED_MUTE))

    OpenMixer = Not (hMixerHandle = 0&
End Function

Public Function CloseMixer() As Boolean
    CloseMixer = (mixerClose(hMixerHandle) = MMSYSERR_NOERROR)
    hMixerHandle = 0
End Function

Public Property Get IsMixerOpened() As Boolean
    IsMixerOpened = Not (hMixerHandle = 0)
End Property

' §§§§§§§§§§§§§§§§§§§§§§§§§§ Перечисление доступных устройств §§§§§§§§§§§§§§§§§§§§§§§§§§

Public Function EnumSndDevices(ByRef strDevices() As String) As Integer ' Перечисление всех устройств
    Dim i As Integer, xCaps As MIXERCAPS

    EnumSndDevices = mixerGetNumDevs()
    EnumSndDevices = EnumSndDevices - &H1
    If Not EnumSndDevices = &HFFFF Then ReDim strDevices(EnumSndDevices)

    For i = 0 To EnumSndDevices
        Call mixerGetDevCaps(i, xCaps, Len(xCaps))
        strDevices(i) = VBA.Left$(xCaps.szPname, InStr(1, xCaps.szPname, vbNullChar) - &H1)
    Next
End Function

' §§§§§§§§§§§§§§§§§§§§§§§§§§ Получение названия §§§§§§§§§§§§§§§§§§§§§§§§§§

Public Property Get MixerVolName(ByVal Control As VOL_CONTROL) As String
    If hMixerHandle = &H0 Then Exit Property

    MixerVolName = uMixerControls(Control).szName
    MixerVolName = Left$(MixerVolName, InStr(1, MixerVolName, vbNullChar) - 1&
End Property

Public Property Get MixerMuteName(ByVal Control As MUTE_CONTROL) As String
    MixerMuteName = MixerVolName(Control)
End Property

' §§§§§§§§§§§§§§§§§§§§§§§§§§ Свойства §§§§§§§§§§§§§§§§§§§§§§§§§§

Public Property Let Volume(ByVal Control As VOL_CONTROL, _
                           ByVal NewVolume As Long)
    Call SetControlValue(hMixerHandle, uMixerControls(Control), NewVolume)
End Property

Public Property Get Volume(ByVal Control As VOL_CONTROL) As Long
    Volume = GetControlValue(hMixerHandle, uMixerControls(Control))
End Property
'___________________________________________________________________________

Public Property Let Mute(ByVal Control As MUTE_CONTROL, _
                         ByVal MuteState As Boolean)
    Call SetControlValue(hMixerHandle, uMixerControls(Control), ByVal Abs(MuteState))
End Property

Public Property Get Mute(ByVal Control As MUTE_CONTROL) As Boolean
    Mute = CBool(GetControlValue(hMixerHandle, uMixerControls(Control)))
End Property

' §§§§§§§§§§§§§§§§§§§§§§§§§§ Реальный код... §§§§§§§§§§§§§§§§§§§§§§§§§§

Private Function GetMixerControl(ByVal hMixer As Long, _
                                 ByVal componentType As Long, _
                                 ByVal ctrlType As Long, _
                                 ByRef mxc As MIXERCONTROL) As Boolean

    Dim mxlc As MIXERLINECONTROLS, mxl As MIXERLINE
    Dim hMem As Long

    If hMixerHandle = &H0 Then Exit Function

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

    If Not mixerGetLineInfo(hMixer, mxl, MIXER_GETLINEINFOF_COMPONENTTYPE) = MMSYSERR_NOERROR Then MsgBox "": Exit Function
    
    mxlc.cbStruct = Len(mxlc)
    mxlc.dwLineID = mxl.dwLineID
    mxlc.dwControl = ctrlType
    mxlc.cControls = 1&
    mxlc.cbmxctrl = Len(mxc)

    hMem = GlobalAlloc(&H40, Len(mxc))
    mxlc.pamxctrl = GlobalLock(hMem)
    mxc.cbStruct = Len(mxc)

    If mixerGetLineControls(hMixer, mxlc, MIXER_GETLINECONTROLSF_ONEBYTYPE) = 0& Then _
        GetMixerControl = True: _
        Call CopyStructFromPtr(mxc, mxlc.pamxctrl, Len(mxc))

    Call GlobalFree(hMem)
End Function

Private Function SetControlValue(ByVal hMixer As Long, _
                                 ByRef mxc As MIXERCONTROL, _
                                 ByVal NewVolume As Long) As Boolean

    Dim mxcd As MIXERCONTROLDETAILS
    Dim hMem  As Long

    If hMixerHandle = &H0 Then Exit Function

    mxcd.item = mxc.cMultipleItems
    mxcd.dwControlID = mxc.dwControlID
    mxcd.cbStruct = Len(mxcd)
    mxcd.cbDetails = Len(NewVolume)

    hMem = GlobalAlloc(&H40, Len(NewVolume))
    mxcd.paDetails = GlobalLock(hMem)
    mxcd.cChannels = 1&

    If mxc.lMaximum > 100 Then NewVolume = NewVolume * (mxc.lMaximum \ 100&
    If NewVolume > mxc.lMaximum Then NewVolume = mxc.lMaximum
    If NewVolume < mxc.lMinimum Then NewVolume = mxc.lMinimum

    Call CopyPtrFromStruct(mxcd.paDetails, NewVolume, Len(NewVolume))
    If mixerSetControlDetails(hMixer, mxcd, &H0) = MMSYSERR_NOERROR Then SetControlValue = True

    Call GlobalFree(hMem)
End Function

Private Function GetControlValue(ByVal hMixer As Long, _
                                 ByRef mxc As MIXERCONTROL) As Long
    Dim mxcd As MIXERCONTROLDETAILS
    Dim hMem As Long

    If hMixerHandle = &H0 Then Exit Function

    mxcd.item = mxc.cMultipleItems
    mxcd.dwControlID = mxc.dwControlID
    mxcd.cbStruct = Len(mxcd)
    mxcd.cbDetails = &H4

    hMem = GlobalAlloc(&H40, &H4)
    mxcd.paDetails = GlobalLock(hMem)
    mxcd.cChannels = 1&

    Call mixerGetControlDetails(hMixer, mxcd, &H0)
    Call CopyStructFromPtr(GetControlValue, mxcd.paDetails, &H4)
    GetControlValue = Abs((GetControlValue * 100) / (mxc.lMaximum - mxc.lMinimum))

    Call GlobalFree(hMem)
End Function

Option Explicit

Private Sub Form_Load()
    Dim i As Long
    Dim sNames() As String

    For i = 0 To mMixer.EnumSndDevices(sNames)  ' Получение всех доступных устройств
        MsgBox "Звуковая карта №" & i + 1 & "  - " & sNames(i)
    Next

    Call mMixer.OpenMixer(0&                   ' Берем первое устройство - 0, оно по умолчанию, но при желании можно работать и с др. звуковушками...

    Call MsgBox("Сейчас громкость будет установлена на максимум - " & mMixer.MixerVolName(SPEAKER))
    mMixer.Volume(SPEAKER) = 100                ' Установка значения
    MsgBox mMixer.Volume(SPEAKER)               ' Получение значения

    Call MsgBox("Сейчас громкость будет установлена на 10% - " & mMixer.MixerVolName(WAVEOUT))
    mMixer.Volume(WAVEOUT) = 10                 ' Установка значения
    MsgBox mMixer.Volume(WAVEOUT)               ' Получение значения

    Call MsgBox("Включение режима Mute, т.е. отключение звука"
    mMixer.Mute(SPEAKER_MUTE) = True            ' Отключение звука
    mMixer.Mute(WAVEOUT_MUTE) = True
    
    Call mMixer.CloseMixer                      ' Закрытие микшера

    End
End Sub

Noviks, лентяй в поиск, битая тема...

лентяй в поиск

Option Explicit
Private Declare Function GetDriveType Lib _
    "kernel32" Alias "GetDriveTypeA" (ByVal _
    nDrive As String) As Long
Private Declare Function mciSendString 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 mciGetErrorString Lib "winmm.dll" Alias "mciGetErrorStringA" (ByVal dwError As Long, ByVal lpstrBuffer As String, ByVal uLength As Long) As Long
Private Const DRIVE_CDROM = 5


Private Sub ComAction_Click(Index As Integer)
Dim str As String * 255
Dim sRet As String * 128
Dim eRet As String * 128
Dim ret As Long
Dim sAlias As String

sAlias = "cd" & List1.List(List1.ListIndex)

str = "open " & List1.List(List1.ListIndex) & ": alias " & sAlias & " type CDAudio"
ret = mciSendString(str, sRet, 255, 0)
If Not ret = 0 Then
    mciGetErrorString ret, eRet, 128
    Debug.Print "err device: " & eRet
    mciSendString "close " & sAlias, vbNullString, 0&, 0
    Exit Sub
Else
Debug.Print "device: " & sRet
End If

If Index = 1 Then
'close
    str = "set " & sAlias & " door closed"
    ret = mciSendString(str, sRet, 255, 0)
        If Not ret = 0 Then
            mciGetErrorString ret, eRet, 128
            Debug.Print "err close: " & eRet
            mciSendString "close " & sAlias, vbNullString, 0&, 0
            Exit Sub
        Else
            Debug.Print "close: " & sRet
        End If

ElseIf Index = 0 Then
'open
    str = "set " & sAlias & " door open"
    ret = mciSendString(str, sRet, 255, 0)
        If Not ret = 0 Then
            mciGetErrorString ret, eRet, 128
            Debug.Print "err open: " & eRet
            mciSendString "close " & sAlias, vbNullString, 0&, 0
            Exit Sub
        Else
            Debug.Print "open: " & sRet
        End If

End If

mciSendString "close all", vbNullString, 0&, 0
End Sub

Sub Form_Load()
Dim s As Long
For s = Asc("A" To Asc("Z"
 If GetDriveType(Chr$(s) & ":" = DRIVE_CDROM Then
  List1.AddItem Chr$(s)
 End If
Next s
End Sub