Программно открыть CD-ROM

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

mciSendString "Set cdaudio door open wait", 0, 0, 0

mciSendString "Set cdaudio door closed wait", 0, 0, 0

Private Const AliasName = "MyCoolCdrom"
Sub EjectCDROM(aLetter As String)
    If mciSendString("open " & aLetter & ": type cdaudio alias " & AliasName & aLetter & " shareable wait", 0, 0, 0) Then
        mciSendString "set " & AliasName & aLetter & " door open wait", 0, 0, 0
        mciSendString "close " & AliasName & aLetter & " wait", 0, 0, 0
    End If
End Sub
Sub CloseCDROM(aLetter As String)
    If mciSendString("open " & aLetter & ": type cdaudio alias " & AliasName & aLetter & " shareable wait", 0, 0, 0) Then
        mciSendString "set " & AliasName & aLetter & " door closed wait", 0, 0, 0
        mciSendString "close " & AliasName & aLetter & " wait", 0, 0, 0
    End If
End Sub
 
'...
EjectCDROM "e"
CloseCDROM "e"

Private Type SECURITY_ATTRIBUTES
    nLength As Long
    lpSecurityDescriptor As Long
    bInheritHandle As Long
End Type 'SECURITY_ATTRIBUTES
 
Private Type OVERLAPPED
    Internal As Long
    InternalHigh As Long
    offset As Long
    OffsetHigh As Long
    hEvent As Long
End Type 'OVERLAPPED
 
Private Declare Function CreateFile Lib "kernel32" _
  Alias "CreateFileA" (ByVal lpFileName As String, _
  ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, _
  lpSecurityAttributes As SECURITY_ATTRIBUTES, _
  ByVal dwCreationDisposition As Long, _
  ByVal dwFlagsAndAttributes As Long, _
  ByVal hTemplateFile As Long) As Long
 
Private Declare Function DeviceIoControl Lib "kernel32" _
  (ByVal hDevice As Long, ByVal dwIoControlCode As Long, _
  lpInBuffer As Any, ByVal nInBufferSize As Long, _
  lpOutBuffer As Any, ByVal nOutBufferSize As Long, _
  lpBytesReturned As Long, lpOverlapped As OVERLAPPED) As Long
 
Private Declare Function CloseHandle Lib "kernel32" _
  (ByVal hObject As Long) As Long
 
Private Const FILE_SHARE_READ = &H1&
Private Const FILE_SHARE_WRITE = &H2&
Private Const OPEN_EXISTING = 3&
Private Const GENERIC_READ = &H80000000
Private Const GENERIC_WRITE = &H40000000
Private Const INVALID_HANDLE_VALUE = -1
Private Const IOCTL_STORAGE_EJECT_MEDIA = &H2D4808
Private Const IOCTL_STORAGE_LOAD_MEDIA = &H2D480C
 
'Функция для открытия дисковода
Public Function EjectCD(ByVal drivePath As String) As Boolean
    Dim drFullPath As String
    Dim hDevice As Long, nBytesReturned As Long
    Dim sa As SECURITY_ATTRIBUTES
    Dim ol As OVERLAPPED
    
    'Удаляем на всякий случай лишнюю косую черту,
    'если путь к дисководу её содержит
    drivePath = Replace(drivePath, "", vbNullString)
    
    'Перед буквой диска обязательно вставить
    'эту комбинацию символов
    drFullPath = "\\." & LCase(drivePath)
    
    'Получим дескриптор дисковода
    hDevice = CreateFile( _
      drFullPath, _
      GENERIC_READ, _
      FILE_SHARE_READ Or FILE_SHARE_WRITE, _
      sa, OPEN_EXISTING, 0, 0)
    
    'Если дескриптор верный, открываем CD-ROM,
    'и возвращаем True для контроля за его состоянием
    If hDevice <> INVALID_HANDLE_VALUE Then
        EjectCD = CBool(DeviceIoControl(hDevice, _
          IOCTL_STORAGE_EJECT_MEDIA, 0, 0, 0, 0, _
          nBytesReturned, ol))
        'Закроем дескриптор, так как он больше не нужен
        CloseHandle hDevice
    End If
End Function 'EjectCD
 
'Функция для закрытия дисковода
Public Function LoadCD(ByVal drivePath As String) As Boolean
    Dim drFullPath As String
    Dim hDevice As Long, nBytesReturned As Long
    Dim sa As SECURITY_ATTRIBUTES
    Dim ol As OVERLAPPED
    
    drivePath = Replace(drivePath, "", "")
    drFullPath = "\\." & LCase(drivePath)
    
    hDevice = CreateFile( _
      drFullPath, _
      GENERIC_READ, _
      FILE_SHARE_READ Or FILE_SHARE_WRITE, _
      sa, OPEN_EXISTING, 0, 0)
    
    If hDevice <> INVALID_HANDLE_VALUE Then
        LoadCD = CBool(DeviceIoControl(hDevice, _
          IOCTL_STORAGE_LOAD_MEDIA, 0, 0, 0, 0, _
          nBytesReturned, ol))
        CloseHandle hDevice
    End If
End Function 'LoadCD

If mciSendString("open " & aLetter & ": type cdaudio alias " & AliasName & aLetter & " shareable wait", 0, 0, 0) Then ...

Debug.Print mciSendString("close " & aLetter & ": type cdaudio alias " & AliasName & aLetter & " shareable wait", 0, 0, 0)