VBA Tipp: Alle Laufwerke eines Typs ermitteln

Aus DBWiki
Wechseln zu: Navigation, Suche

Aufgabenstellung

Ich möchte alle Laufwerke eines bestimmten Typs ermitteln.

Lösung

Das geht mit folgender API-Deklaration und VBA-Funktion, die in einem allgemeinen (globalen) Modul gespeichert werden.

Option Explicit
 
' Rückgabewerte der Funktion GetDriveType
' werden im Argument "Drivetype" verwendet
Public Const DRIVE_UNKNOWN = 0        ' Unbekannter Laufwerkstyp
Public Const DRIVE_NO_ROOT_DIR = 1    ' Laufwerk existiert nicht
Public Const DRIVE_REMOVABLE = 2      ' Wechseldatenträger (USB-Stick, Diskettenlaufwerk)
Public Const DRIVE_FIXED = 3          ' Festplatte (auch USB-Festplatte)
Public Const DRIVE_REMOTE = 4         ' Netz-Laufwerk
Public Const DRIVE_CDROM = 5          ' CD/DVD-Laufwerk
Public Const DRIVE_RAMDISK = 6        ' RAM-Laufwerk
 
Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" ( _
                         ByVal lpRootPathName As String) As Long
 
 
Public Function GetAllDrivesOfType(Optional Drivetype = DRIVE_CDROM)
 
   ' Quelle: http://www.dbwiki.net/
 
   Dim strBuchstabe As String
   Dim strText      As String
   Dim i            As Long
 
   For i = Asc("A") To Asc("Z")
 
      strBuchstabe = Chr(i)
 
      If GetDriveType(strBuchstabe & ":\") = Drivetype Then
         strText = strText & ";" & strBuchstabe
      End If
 
   Next
 
   GetAllDrivesOfType = Mid(strText, 2)
 
End Function

Aufruf

Anzeige im Direktfenster

   ' Laufwerksbuchstaben aller CD-ROM-Laufwerke anzeigen
   Debug.Print GetAllDrivesOfType()             ' ergibt z.B. E
 
   ' Laufwerksbuchstaben aller Festplatten anzeigen
   Debug.Print GetAllDrivesOfType(DRIVE_FIXED)  ' ergibt z.B. A;C;D
 
   ' Nicht existierende (unbelegte) Laufwerke anzeigen
   Debug.Print GetAllDrivesOfType(DRIVE_NO_ROOT_DIR)