Option Explicit

'オーディオ機器制御用API
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

'ドライブにアクセスできないときに
'アクセスエラーになる前のドライブ名を保持する変数です
Dim m_BeforeDrive As String

'ドライブの開閉の制御をします
Private Sub Command1_Click()
    If Command1.Caption = "ドライブを開く" Then
        Command1.Enabled = False
        Call mciSendString("Set CDAudio Door Open Wait", 0&, 0&, 0&)
        Command1.Enabled = True
        Command1.Caption = "ドライブを閉じる"
        
    ElseIf Command1.Caption = "ドライブを閉じる" Then
        Command1.Enabled = False
        Call mciSendString("Set CDAudio Door Closed Wait", 0&, 0&, 0&)
        Command1.Enabled = True
        Command1.Caption = "ドライブを開く"
    End If
End Sub

'ドライブの変更をします
Private Sub Drive1_Change()
    On Error GoTo ErrProcess
    
    Dir1.Path = Drive1.Drive
    m_BeforeDrive = Drive1.Drive
    Exit Sub
ErrProcess:
    'エラーの表示をします
    MsgBox Err.Description, vbExclamation
    'アクセスエラー前のドライブに戻します
    'ループしないように制御します
    If Not (Drive1.Drive = m_BeforeDrive) Then
        Drive1.Drive = m_BeforeDrive
    End If
End Sub

'フォームをロードしました
Private Sub Form_Load()
    m_BeforeDrive = Drive1.Drive
End Sub