Laufwerk bereit/schreibgeschützt? Mit dieser Funktion lässt sich ermitteln, ob ein bestimmtes Laufwerk bereit ist und optional auch, ob auf den Datenträger geschrieben werden kann.
Autor:   Dieter Otter	Bewertung:     [ Jetzt bewerten ]	Views:  9.592
https://www.tools4vb.com	System:  Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11	Beispielprojekt auf CD

Geben Sie hier Ihre persönliche Bewertung ab! Anzahl Bewertungen bisher: 4 Bewertung insgesamt: gut Durchschnittliche Bewertung: 4.0 von 5 Sternen

sehr gut     gut     nützlich     mittelmäßig     mangelhaft

Mit nachfolgender Funktion lässt sich prüfen, ob ein bestimmtes Laufwerk bereit ist (bspw. ein Disketten- oder ZIP-Laufwerk) und optional auch, ob auf den Datenträger geschrieben werden kann.

Fügen Sie nachfolgenden Code in ein Modul ein:

Option Explicit
 
' Benötigte API-Deklaration
Private Declare Function GetVolumeInformation Lib "kernel32" _
  Alias "GetVolumeInformationA" ( _
  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 Long
 
Private Declare Function SetVolumeLabel Lib "kernel32" _
  Alias "SetVolumeLabelA" ( _
  ByVal lpRootPathName As String, _
  ByVal lpVolumeName As String) As Long

Public Function CheckDrive(ByVal sDrive As String, _
  Optional ByVal bForeCheckWriteAccess As Boolean = False) As Boolean
 
  ' Prüft, ob der Datenträger bereit ist und
  ' optional, ob darauf geschrieben werden kann
 
  Dim bResult As Boolean
  Dim sVolName As String
  Dim sTemp As String
 
  bResult = False
  On Error GoTo ErrHandler
 
  ' Datenträgerbezeichnung lesen
  If Len(sDrive) = 1 Then sDrive = sDrive & ":"
  If Len(sDrive) = 2 Then sDrive = sDrive & "\"
 
  sTemp = Space$(255)
  sVolName = Space$(255)
 
  If GetVolumeInformation(sDrive, sVolName, Len(sVolName), _
    0&, 0&, 0&, sTemp, Len(sTemp)) > 0 Then
 
    ' Falls kein Fehler auftrat, ist der Datenträger bereit
    bResult = True
 
    ' Falls zusätzlich geprüft werden soll, ob auf
    ' den Datenträger geschrieben werden kann...
    If bForeCheckWriteAccess Then
      If InStr(sVolName, Chr$(0)) > 0 Then
        sVolName = Left$(sVolName, InStr(sVolName, Chr$(0)) - 1)
      End If
      bResult = (SetVolumeLabel(sDrive, sVolName) <> 0)
    End If
  End If
 
ErrHandler:
  CheckDrive = bResult
End Function

Aufrufbeispiele:

' Prüfen, ob in Laufwerk A: eine Diskette eingelegt 
' ist und ob darauf geschrieben werden kann
If CheckDrive("A:", True) = False Then
  MsgBox "Entweder keine Diskette im Laufwerk A: oder " & _
    "der Datenträger ist schreibgeschützt!", vbCritical
End If

' Prüfen, ob Laufwerk D: bereit
If CheckDrive("D:") Then
  ' ...
End If