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 Const DRIVE_REMOVABLE = 2
Private Const DRIVE_FIXED = 3
Private Const DRIVE_REMOTE = 4
Private Const DRIVE_CDROM = 5
Private Const DRIVE_RAMDISK = 6
 
Private Sub Command1_Click()
Dim LW As String
 
  ' Aufruf
  LW = GetCD("OrdnerAufDerCd\EineBekannteDateiAufDerCdRom")
 
  If LW <> "" Then
    MsgBox "CD gefunden!, Laufwerk: " & LW & ":\"
  Else
    MsgBox "CD nicht gefunden!"
  End If
 
End Sub
 
 Private Function GetAllDrives(Optional ByVal DriveType As Long = 0) As String
  Dim I As Integer
  Dim Result As Long
  Dim Drives() As String
  Dim Dummy As String
  Dim sDrives As String
 
  Dummy = Space(255)
  Result = GetLogicalDriveStrings(Len(Dummy), Dummy)
 
  Drives = Split(Dummy, Chr$(0))
  For I = 0 To UBound(Drives) - 1
    If GetDriveType(Drives(I)) = DriveType Or _
      DriveType = 0 Then
      sDrives = sDrives & Left$(Drives(I), 2)
    End If
  Next I
  GetAllDrives = sDrives
End Function
 
Private Function GetCD(Datei As String) As String
Dim sDrives As String
Dim SplitDrive() As String
Dim N As Integer
Dim LaufwerksBuchstabe As String
 
  sDrives = GetAllDrives(DRIVE_CDROM)
 
  SplitDrive = Split(sDrives, ":")
 
  For N = 0 To UBound(SplitDrive) - 1
    If FileExists(SplitDrive(N) & ":\" & Datei) Then
      GetCD = SplitDrive(N)
      Exit For
    End If
  Next
End Function
 
Private Function FileExists(Filename$) As Boolean
On Error GoTo Fehler
 
  FileExists = (Dir$(Filename$) <> "")
  Exit Function
 
Fehler:
  ' Keine CD Im Laufwerk
  Exit Function
End Function