Option Explicit
 
Private Declare Function GetDriveType Lib "kernel32" Alias _
        "GetDriveTypeA" (ByVal nDrive As String) As Long
 
Private Const DRIVE_CDROM = 5
 
 
Private Sub Command2_Click()
If InListe(List1, "D:") Then
  MsgBox "Ja - vorhanden!"
End If
 
End Sub
 
Private Sub Form_Load()
  BI_GetCDROMDrive
End Sub
 
 
Private Function BI_GetCDROMDrive() As String
  Dim lType As Long
  Dim I As Integer
  Dim tmpDrive As String
  Dim found As Boolean
 
  On Error GoTo ErrorHandler
 
  'Schleife von A - Z
  For I = 0 To 25
     tmpDrive = Chr(65 + I) & ":"
 
     'Win32 API Funktion
     lType = GetDriveType(tmpDrive)
 
     'Win32 API Konstante
     If (lType = DRIVE_CDROM) Then
        found = True
        List1.AddItem tmpDrive
      End If
  Next
 
  If Not found Then
     tmpDrive = ""
     List1.AddItem "Kein CD-ROM vorhanden"
  End If
 
  BI_GetCDROMDrive = tmpDrive
  Exit Function
 
ErrorHandler:
  Err.Description = "Es ist ein unerwarteter Fehler aufgetreten."
  MsgBox Err.Description
 
End Function
 
Private Sub Command1_Click()
  Unload Me
  End
End Sub
 
Private Function InListe(Liste As ListBox, ByVal sText As String) As Integer
  Dim I As Integer
  Dim Index As Integer
 
  Index = -1
  With Liste
    For I = 0 To .ListCount - 1
      If .List(I) = sText Then
        Index = I: Exit For
      End If
    Next I
  End With
 
  InListe = Index
End Function