Tu peux peut-être t'inspirer de ça :
Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
Private Declare Function mciExecute Lib "winmm.dll" (ByVal lpstrCommand As String) As Long
Function ouvre()
Dim a
a = OpenCloseCD(GetListCDDrive, True, False)
End Function
Function ferme()
Dim a
a = OpenCloseCD(GetListCDDrive, False, False)
End Function
Public Function GetListCDDrive() As String
Dim I As Integer
Dim nCDDrive As String
Dim RetCDDrive As String
Const DRIVE_CDROM = 5
For I = 65 To 90
nCDDrive = Chr$(I) & ":\"
If GetDriveType(nCDDrive) = DRIVE_CDROM Then
RetCDDrive = RetCDDrive & nCDDrive & ";" '
End If
Next 'i
GetListCDDrive = Left(RetCDDrive, Len(RetCDDrive) - 1)
End Function
Public Function GetFirstCDDrive() As String
Dim I As Integer
Dim nCDDrive As String
Const DRIVE_CDROM = 5
For I = 65 To 90
nCDDrive = Chr$(I) & ":\"
If GetDriveType(nCDDrive) = DRIVE_CDROM Then
GetFirstCDDrive = nCDDrive
Exit For
End If
Next 'i
End Function
Public Function OpenCloseCD(Optional Drive As String, Optional ByVal OpenClose As Boolean = True, Optional FindFirstCDDrive As Boolean) As Boolean
Dim nDrive As String
Dim nExec As String
Dim nAlias As String
Dim nResult As Long
Const DRIVE_CDROM = 5
If FindFirstCDDrive Then
nDrive = GetFirstCDDrive()
Else
nDrive = Trim$(Drive)
If Len(nDrive) Then
nDrive = Left$(nDrive, 1)
If nDrive Like "[a-z]" Then
If GetDriveType(nDrive & ":\" ) <> DRIVE_CDROM Then
Exit Function
End If
End If
End If
End If
If Len(nDrive) Then
nAlias = "CDDrive" & nDrive
nExec = "Open " & nDrive & ": Type CDAudio Alias " & nAlias
nResult = mciExecute(nExec)
If nResult Then
If OpenClose Then
nExec = "Set " & nAlias & " Door Open"
Else
nExec = "Set " & nAlias & " Door Closed"
End If
nResult = mciExecute(nExec)
If nResult Then
nExec = "Close " & nAlias
nResult = mciExecute(nExec)
OpenCloseCD = True
End If
End If
End If
End Function
