Laufwerke

GetDiskFreeSpaceEx

Ermittelt, wieviel Speicherplatz ein Laufwerk insgesamt hat, wieviel davon frei ist und wieviel davon für den aktuellen User verfügbar ist. Der eigentliche Rückgabewert der Funktion ist postiv, wenn die Funktion erfolgreich war.

Im Parameter lpDirectoryName kann ein beliebiges Verzeichnis angegeben werden. Es wird das angegebene Laufwerk zu diesem Verzeichnis ausgewertet. Ohne Angabe wird das aktuelle Laufwerk ausgewertet. Es kann auch ein Netzwerk angegeben werden.

Die Funktion gibt die Werte auf ein Byte genau zurück. Damit ergibt sich für ein 32-Bit Office ein Problem: In Variablen von Typ Long könnten maximal Werte für bis zu 2 GB zurückgegeben werden. Größere Werte verursachen einen Überlauf. Inzwischen ist es aber eher unwahrscheinlich, überhaupt noch Speichermedien unter 2 GB zu finden. Und da man sich normalerweise auch kaum für eine bytegenaue Angabe interessiert, speichern die folgenden Funktionen die Werte in Variablen vom Typ Currency, und geben die Ergebnisse in Gigabyte zurück. Falls doch einmal Ergebnisse bis auf ein Byte genau benötigt werden, könnte man das Ergebnis auch als String zurückgeben - vorausgesetzt, mit dem Ergebnis muss dann nicht noch gerechnet werden.

#If VBA7 Then
    Private Declare PtrSafe Function GetDiskFreeSpaceExA Lib "kernel32" _
        (ByVal lpDirectoryName As String, _
        lpFreeBytesAvailable As Currency, _
        lpTotalNumberOfBytes As Currency, _
        lpTotalNumberOfFreeBytes As Currency) _
    As Boolean
#Else
    Private Declare Function GetDiskFreeSpaceExA Lib "kernel32" _
        (ByVal lpDirectoryName As String, _
        lpFreeBytesAvailable As Currency, _
        lpTotalNumberOfBytes As Currency, _
        lpTotalNumberOfFreeBytes As Currency) _
    As Boolean
#End If

Public Function
apiTotalGB(Optional strDirectory As String) As Long Dim curAvailable As Currency, curTotal As Currency, curNumber As Currency If GetDiskFreeSpaceExA(strDirectory, curAvailable, curTotal, curNumber) Then apiTotalGB = curTotal * 10000 / 1024 / 1024 / 1024 'Currency / KB / MB / GB End If End Function
Public Function
apiFreeGB(Optional strDirectory As String) As Long Dim curAvailable As Currency, curTotal As Currency, curNumber As Currency If GetDiskFreeSpaceExA(strDirectory, curAvailable, curTotal, curNumber) Then apiFreeGB = curNumber * 10000 / 1024 / 1024 / 1024 End If End Function
Public Function
apiAvailableGB(Optional strDirectory As String) As Long Dim curAvailable As Currency, curTotal As Currency, curNumber As Currency If GetDiskFreeSpaceExA(strDirectory, curAvailable, curTotal, curNumber) Then apiAvailableGB = curAvailable * 10000 / 1024 / 1024 / 1024 End If End Function

GetDriveType

Ermittelt, um was für eine Art von Laufwerk es sich handelt.

Im Parameter nDrive muss ein beliebiges, existierendes Verzeichnis angegeben werden. Es wird das angegebene Laufwerk zu diesem Verzeichnis ausgewertet. Es kann auch ein Netzwerk angegeben werden.

#If VBA7 Then
    Public Declare PtrSafe Function GetDriveType Lib "kernel32" _
        Alias "GetDriveTypeA" (ByVal nDrive As String) As eDriveType
#Else
    Public Declare PtrSafe Function GetDriveType Lib "kernel32" _
        Alias "GetDriveTypeA" (ByVal nDrive As String) As eDriveType
#End If

Public Enum eDriveType
    DRIVE_UNKNOWN = 0       'Typ nicht ermittelbar
    DRIVE_NO_ROOT_DIR = 1   'Pfad ungültig
    DRIVE_REMOVABLE = 2     'z.B. Floppy, SD Karte, USB-Stick, ...
    DRIVE_FIXED = 3         'Festplatte etc.
    DRIVE_REMOTE = 4        'Netzwerk
    DRIVE_CDROM = 5         'CD-ROM
    DRIVE_RAMDISK = 6       'RAM
End Enum

GetLogicalDrives

Gibt einen Longwert zurück, der eine Bitmaske darstellt. Jedes der ersten 26 Bit steht für je einen Laufwerksbuchstaben. Das erste Bit steht also für „A:\“, das zweite für „B:\“ usw. Die folgende Tabelle zeigt die entsprechenden Bitwerte. Ist der entsprechende Laufwerksbuchstabe momentan vorhanden, steht das Bit auf „1“, sonst auf „0“.

Bitmaske GetLogicalDrives
ABCDEFGH IJKLMNOP QRSTUVWX YZ
1
2
4
8
16
32
64
128
256
512
1024
2048
4096
8192
16384
32768
65536
131072
262144
524288
1048576
2097152
4194304
8388608
16777216
33554432

Die folgende Beispielfunktion erwartet einen Laufwerksbuchstaben als Parameter und gibt True zurück, wenn es dieses Laufwerk gibt.

#If VBA7 Then
    Private Declare PtrSafe Function GetLogicalDrives Lib "kernel32" () As Long
#Else
    Private Declare Function GetLogicalDrives Lib "kernel32" () As Long
#End If

Public Function
apiDriveExists(strDrive As String) As Boolean Dim lngDrive As Long 'Falls strDrive mit einem ungültigen Zeichen beginnt, wird False zurückgegeben On Error Resume Next lngDrive = 2 ^ (Asc(UCase(Left(strDrive, 1))) - 65) apiDriveExists = GetLogicalDrives And lngDrive End Function

Um die Existenz eines einzigen, bestimmten Laufwerksbuchstaben zu prüfen, ist in der Praxis GetLogicalDriveStrings einfacher zu nutzen. GetLogicalDrives ist dagegen dann hilfreich, wenn in einem einzigen Aufruf auf mehrere Laufwerke gleichzeitig geprüft werden soll:

Debug.Print (GetLogicalDrives AND 6) > 0 'Gibt es B oder C?
Debug.Print (GetLogicalDrives AND 6) = 6 'Gibt es B und C?

GetLogicalDriveString

Ermittelt einen String, in dem alle derzeit vorhandenen Laufwerke aufgeführt werden. Der String kann etwa wie folgt aussehen:

C:\ D:\ F:\ Z:\

Die Laufwerksbezeichnungen werden dabei nicht etwa mit einem Leerzeichen (Chr(32)) getrennt, sondern mit vbNullChar (Chr(0)). Je nach Bedarf kann man im String z. B. mit InStr nach einem Laufwerk suchen, oder mit Split ein Array erzeugen, das man anschließend vielleicht in einer Schleife verwenden will. Diese beiden Anwendungsfälle werden in den folgenden Funktionen aufgezeigt. In apiLogicalDriveString werden außerdem die trennenden vbNullChar-Zeichen gelöscht, weil der Puffer strDrives sonst überzählige vbNullChar-Zeichen am Ende aufweist.

#If VBA7 Then
    Private Declare PtrSafe Function GetLogicalDriveStringsA Lib "kernel32" _
        (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
#Else
    Private Declare Function GetLogicalDriveStringsA Lib "kernel32" _
        (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
#End If

Public Function
apiLogicalDriveString() As String Dim strDrives As String * 104 '26 Buchstaben * 4 Zeichen If GetLogicalDriveStringsA(104, strDrives) > 0 Then apiLogicalDriveString = Replace(strDrives, vbNullChar, "") End If End Function
Public Function
apiLogicalAllDrives() As String() Dim strDrives As String * 104 '26 Buchstaben * 4 Zeichen If GetLogicalDriveStringsA(104, strDrives) > 0 Then apiLogicalAllDrives = Split(strDrives, ":\" & vbNullChar) End If End Function

GetVolumeInformation

Gibt verschiedene Informationen zu einem Laufwerk zurück, wie z. B. Laufwerksnamen und Seriennummer.

lpFileSystemNameBuffer gibt das verwendete Dateisystem zurück, also z. b. FAT32 oder NTFS. apiFileComponentLen gibt an, wie viele Zeichen ein Datei- oder Verzeichnisname maximal lang sein kann. lpFileSystemFlags gibt eine Reihe von Flags zurück, mit denen weitere Eigenschaften abgefragt werden können. Sie sind im Beispielcode unter eFileSystemFlags aufgeführt.

Im Parameter lpRootPathName kann ein beliebiges, existierendes Verzeichnis angegeben werden. Es wird das angegebene Laufwerk zu diesem Verzeichnis ausgewertet. Ohne Angabe wird das aktuelle Laufwerk ausgewertet. Es kann auch ein Netzwerk angegeben werden.

#If VBA7 Then
    Private Declare PtrSafe Function GetVolumeInformationA Lib "kernel32" _
        (ByVal lpRootPathName As String, _
        ByVal lpVolumeNameBuffer As String, ByVal nVolumeNameSize As Long, _
        lpVolumeSerialNumber As LongPtr, _
        lpMaximumComponentLength As LongPtr, _
        lpFileSystemFlags As LongPtr, _
        ByVal lpFileSystemNameBuffer As String, ByVal nFileSystemNameSize As Long) _
    As Boolean
#Else
    Private Declare PtrSafe Function GetVolumeInformationA Lib "kernel32" _
        (ByVal lpRootPathName As String, _
        ByVal lpVolumeNameBuffer As String, ByVal nVolumeNameSize As Long, _
        lpVolumeSerialNumber As Long, _
        lpMaximumComponentLength As Long, _
        lpFileSystemFlags As Long, _
        ByVal lpFileSystemNameBuffer As String, ByVal nFileSystemNameSize As Long) _
    As Boolean
#End If

Public Enum eFileSystemFlags              'Das Laufwerk ....
    FILE_CASE_PRESERVED_NAMES = &H2       'behält Groß-/Kleinschreibung der Dateinamen
    FILE_CASE_SENSITIVE_SEARCH = &H1      'unterstützt Groß-/Kleinschreibung der Dateinamen
    FILE_FILE_COMPRESSION = &H10          'unterstützt dateibasiertes Komprimieren
    FILE_NAMED_STREAMS = &H40000          'unterstützt Dateistreams
    FILE_PERSISTENT_ACLS = &H8            'speichert Zugriffskontrolllisten (ACL)
    FILE_READ_ONLY_VOLUME = &H80000       'ist nur lesbar
    FILE_SEQUENTIAL_WRITE_ONCE = &H100000 'unterstützt einzelsequentielles Schreiben
    FILE_SUPPORTS_ENCRYPTION = &H20000    'unterstützt verschlüsselte Dateisysteme (EFS)
    FILE_SUPPORSTS_EXTENDED_ATTRIBUTES = &H800000 'unterstützt applikationsspezifische Attribute
    FILE_SUPPORTS_HARD_LINKS = &H400000   'unterstützt Hard Links
    FILE_SUPPORTS_OBJECT_IDS = &H10000    'unterstützt Objekt IDs
    FILE_SUPPORTS_OPEN_BY_FILE_ID = &H1000000     'unterstützt Open By File ID
    FILE_SUPPORTS_REPARSE_POINTS = &H80   'unterstützt Reparse-Punkte
    FILE_SUPPORTS_SPARSE_FILES = &H40     'unterstützt Sparse-Dateien
    FILE_SUPPORTS_TRNSACTIONS = &H200000  'unterstützt Transaktionen
    FILE_SUPPORTS_USN_JOURNAL = &H2000000 'unterstützt Update Sequence Number (USN) Journale
    FILE_UNICODE_ON_DISK = &H4            'speichert Dateinamen als Unicode-Strings
    FILE_VOLUME_IS_COMPRESSED = &H8000    'ist komprimiert
    FILE_VOLUME_QUOTAS = &H20             'unterstützt Laufwerksanteile

    'Ab Windows 10, Version 1607:
    FILE_DAX_VOLUME = &H20000000          'ist ein direct access system (DAX)
End Enum

Public Function
apiVolumeName(Optional strDirectory As String) As String Dim strVolumeName As String * 255 GetVolumeInformationA strDirectory, strVolumeName, 255, 0, 0, 0, vbNullString, 0 apistrVolumeName = Replace(strVolumeName, vbNullChar, "") End Function
Public Function
apiSerienNummer(Optional strDirectory As String) #If VBA7 Then Dim lngSerialNumber As LongPtr #Else Dim lngSerialNumber As Long #End If GetVolumeInformationA strDirectory, vbNullString, 0, lngSerialNumber, 0, 0, vbNullString, 0 apiSerienNummer = lngSerialNumber End Function
Public Function
apiFileComponentLen(Optional strDirectory As String) #If VBA7 Then Dim lngMaxLen As LongPtr #Else Dim lngMaxLen As Long #End If GetVolumeInformationA strDirectory, vbNullString, 0, 0, lngMaxLen, 0, vbNullString, 0 apiFileComponentLen = lngMaxLen End Function
Public Function
apilngFileSystem(Optional strDirectory As String, _ Optional Flags As eFileSystemFlags = &HFFFFFFFF) #If VBA7 Then Dim lngFileSystem As LongPtr #Else Dim lngFileSystem As Long #End If GetVolumeInformationA strDirectory, vbNullString, 0, 0, 0, lngFileSystem, vbNullString, 0 apilngFileSystem = lngFileSystem And Flags End Function