A twist on CD eject

[Matthew624]

How could I alter the code for ejecting a CD-ROM so that, on a PC with multiple CD-ROM drives, the drive that ejects is always the one containing the CD with my app on it? Could I use app.Path somehow?

Thanks

[Big_Berdie]

I've never seen the code used to open a Cd-ROm drive. Does it contain a drive letter or is it just sort of generic? If it has a drive letter, and the program runs, or accesses files from the cd then app.path might work! Can you post the actual code to open the CD??
thanx

[HeSaidJoe]

'open and close the cd door'

Option Explicit

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

'===============================================================

'To open the CD door, use this code:

retvalue = mcisendstring("set CDAudio door open", _
returnstring, 127, 0)

'To close the CD door, use this code:

retvalue = mcisendstring("set CDAudio door closed", _
returnstring, 127, 0)

This code, I believe finds all CD letters.

Const DRIVE_CDROM = 5

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

Private Sub Command1_Click()
Dim tmp As Integer
Dim tmpStr As String
Dim Drives As String
Dim CDsCount As Integer
Dim CDsLetters As String

'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
  CDsLetters = CDsLetters & Left(tmpStr, 1) & " "
 End If
Next tmp
'display results
If CDsCount Then
 MsgBox "Number of CDs Available: " & CDsCount & " - CDs Letters: " & UCase(CDsLetters)
Else
 MsgBox "No CDs Available"
End If
End Sub