Option Explicit

Private m_objFSO As FileSystemObject

Private Sub Form_Load()
  Dim astrDrives() As String
  Dim i As Integer

  Set m_objFSO = New FileSystemObject

  If GetAllDrives(astrDrives) Then
    With Me.lstDrives
      For i = 0 To UBound(astrDrives)
        .AddItem astrDrives(i)
      Next
      .ListIndex = 0
    End With
  Else
    Me.lstDrives.Clear
    Me.txtDriveInfo.Text = "Es ist ein Fehler aufgetreten!"
  End If
End Sub

Private Sub lstDrives_Click()
  Me.txtDriveInfo.Text = _
      GetDriveInfos(Left$(Me.lstDrives.Text, 1))
End Sub

Private Function GetAllDrives(ByRef astrDrives() As String) _
      As Boolean
  Dim fsoDrives   As Drives
  Dim fsoDrive    As Drive
  Dim strDrive    As String
  Dim nDrive      As Long

  On Error GoTo err_GetAllDrives

  Set fsoDrives = m_objFSO.Drives

  ReDim astrDrives(0 To fsoDrives.Count - 1)
  nDrive = -1

  For Each fsoDrive In fsoDrives
    strDrive = fsoDrive.DriveLetter & ":  "

    Select Case fsoDrive.DriveType
      Case 0: strDrive = strDrive & "Unbekannt"
      Case 1: strDrive = strDrive & "Wechseldatenträger"
      Case 2: strDrive = strDrive & "Lokaler Datenträger"
      Case 3: strDrive = strDrive & "Netzwerklaufwerk"
      Case 4: strDrive = strDrive & "CD-ROM-Laufwerk"
      Case 5: strDrive = strDrive & "Virtuelles Laufwerk"
    End Select

    nDrive = nDrive + 1
    astrDrives(nDrive) = strDrive
  Next

  GetAllDrives = True

exit_Func:
  On Error GoTo 0
  Set fsoDrives = Nothing
  Exit Function

err_GetAllDrives:
  MsgBox "Fehler " & Err.Number & vbCrLf & _
      Err.Description, vbOKOnly + vbCritical
  Resume exit_Func
End Function

Private Function GetDriveInfos(ByVal strDriveSel As String) _
      As String
  Dim fsoDrive As Drive
  Dim strInfo  As String

  Set fsoDrive = m_objFSO.GetDrive(strDriveSel)
  With fsoDrive
    If .IsReady = True Then
      strInfo = "Laufwerk: " & .DriveLetter & vbCrLf
      strInfo = strInfo & "Bezeichnung: " & .VolumeName & vbCrLf
      strInfo = strInfo & "Dateisystem: " & .FileSystem & vbCrLf
      strInfo = strInfo & "Serial-Nr: " & .SerialNumber & vbCrLf
      strInfo = strInfo & "Speicherkapazität: " & _
                 FormatNumber(.TotalSize, 0) & " bytes" & vbCrLf
      strInfo = strInfo & "Freier Speicher: " & _
                 FormatNumber(.FreeSpace, 0) & " bytes"

    Else
      strInfo = "Laufwerk " & .DriveLetter & " nicht bereit!"
    End If
  End With
  Set fsoDrive = Nothing

  GetDriveInfos = strInfo
End Function

Private Sub Form_Terminate()
  Set m_objFSO = Nothing
End Sub