Private Declare Function GetLogicalDrives Lib "kernel32" () As Long
 
Private Function DebugDrives()
  '----------------------------------------------------------
  ' Erstellt eine Collection aller vorhandenen Laufwerke
  Dim sDrive          As String             ' Laufwerksbuchstabe
  Dim dwDrives        As Long               ' Bitmask der verfügbaren logischen 
  ' Laufwerke
  '----------------------------------------------------------
  dwDrives = GetLogicalDrives()
  sDrive = "A"
  '----------------------------------------------------------
  ' Loop solange wie noch was in dwDrives vorhanden ist
  Do While (dwDrives > 0)
    If (dwDrives And 1) = 1 Then        ' Ein logisches Laufwerk mit diesem 
    ' Buchstaben existiert
      Debug.Print "Drive: " & sDrive
      dwDrives = dwDrives - 1           ' Dieses Bit entfernen
    End If
    sDrive = Chr$(Asc(sDrive) + 1)      ' Den nächsten Buchstaben nehmen
    dwDrives = dwDrives  2             '
  Loop
  '----------------------------------------------------------
End Function