Ejecting CD-ROM with multiple drives

[Chavez]

I have the code to eject a CD tray, but how do you distinguish between drives on computers with multiple CD-ROM drives?

[Matthew Gates]

Option Explicit 

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 Sub CloseDoor(ByVal DriveLetter As String) 
    Dim AliasName As String 
    AliasName = "Drive" & DriveLetter     mciSendString "Open " & DriveLetter & ": Alias " & AliasName _ 
    & " Type CDAudio", 0, 0, 0 
    mciSendString "Set " & AliasName & " Door Closed", 0, 0, 0 
End Sub 

Private Sub OpenDoor(ByVal DriveLetter As String) 
    Dim AliasName As String 
    AliasName = "Drive" & DriveLetter 
    mciSendString "Open " & DriveLetter & ": Alias " & AliasName _ 
    & " Type CDAudio", 0, 0, 0 
    mciSendString "Set " & AliasName & " Door Open", 0, 0, 0 
End Sub


Usage


Private Sub Command1_Click() 
    Call OpenDoor(Left(Drive1.Drive, 2)) 
End Sub 

Private Sub Command2_Click() 
    Call CloseDoor(Left(Drive1.Drive, 2))
End Sub

[JamesM]

And to find all the cdroms on a system:

[code]Option Explicit

Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" _
(ByVal nDrive As String) As Long
Private Declare Function GetLogicalDriveStrings Lib "kernel32" Alias "GetLogicalDriveStringsA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long

Function FINDCDLETTERS() As Variant
'Returns an array containing all cd rom drives Or Null of none found
Dim tmp As Integer
Dim tmpStr As String
Dim Drives As String
Dim CDsCount As Integer
Dim CDDrives() As String: ReDim CDDrives(0)
Dim ret As Long
Const DRIVE_CDROM = 5

'init Drives To 255 spaces
Drives = Space(255)
'get drives, Drives var will look like
' A:\<NULL>C:\<NULL>D:\<NULL>E:\<NULL><NULL>
'ret& is the New length of Drives
ret = GetLogicalDriveStrings(Len(Drives), Drives)
For tmp = 1 To ret Step 4
'get a drive root directory (like "C:\")
tmpStr = Mid(Drives, tmp, 3)
'if drive is a CD
If GetDriveType(tmpStr) = DRIVE_CDROM Then
CDsCount = CDsCount + 1
If CDDrives(0) <> "" Then ReDim Preserve CDDrives(UBound(CDDrives) + 1)
CDDrives(UBound(CDDrives)) = Left(tmpStr, 1)
End If
Next tmp
If CDDrives(0) = "" Then FINDCDLETTERS = Null Else FINDCDLETTERS = CDDrives
End Function


Example of using the function:

Private Sub Command1_Click()
Dim a As Variant, i As Integer
a = FINDCDLETTERS
If Not IsNull(a) Then
    For i = 0 To UBound(a)
        MsgBox a(i)
    Next
End If
End Sub

[Chavez]

Thanks for the replies. They both work great!