VBA-Beispiel 097
mail schreiben
mail schreiben

mit VBA Laufwerksinformationen ermitteln
Dieses Makro stellt in einer Gesamtliste aller Laufwerke verschiedene Informationen über jedes Laufwerk zusammen. Zum Beispiel belegter Speicher, freier Speicher, Seriennummer, Laufwerksname...

Hinweis:
Damit die Prozedur funktioniert, müssen Sie im Editor unter Extras/Verweise einen Verweise setzen:

  • Microsoft Scripting Runtime
Sub Info_Laufwerke()
'benötigt Verweis auf "Microsoft Scripting Runtime"
Dim fso As New FileSystemObject
Dim LW As Drive
Dim Zeile As Integer

Cells.Clear
On Error Resume Next
Zeile = 2
Range("A1", "L1") = Array("AvailableSpace", "DriveLetter", "DriveType" _
    , "FileSystem", "FreeSpace", "IsReady", "Path", "RootFolder" _
    , "SerialNumber", "ShareName", "TotalSize", "VolumeName")

For Each LW In fso.Drives

  If LW.DriveType = 1 Then    'Diskette
    Cells(Zeile, 1) = Format(LW.AvailableSpace / 1000000, "0.00") & " MB"
    Cells(Zeile, 5) = Format(LW.FreeSpace / 1000000, "0.00") & " MB"
    Cells(Zeile, 11) = Format(LW.TotalSize / 1000000, "0.00") & " MB"
  Else
    Cells(Zeile, 1) = Format(LW.AvailableSpace / 1000000000, "0.00") & " GB"
    Cells(Zeile, 5) = Format(LW.FreeSpace / 1000000000, "0.00") & " GB"
    Cells(Zeile, 11) = Format(LW.TotalSize / 1000000000, "0.00") & " GB"
  End If

  Cells(Zeile, 2) = LW.DriveLetter
  Cells(Zeile, 3) = LW.DriveType
  Cells(Zeile, 4) = LW.FileSystem
  Cells(Zeile, 6) = LW.IsReady  
  Cells(Zeile, 7) = LW.Path
  Cells(Zeile, 8) = LW.RootFolder
  Cells(Zeile, 9) = LW.SerialNumber
  Cells(Zeile, 10) = LW.ShareName
  Cells(Zeile, 12) = LW.VolumeName
  Zeile = Zeile + 1
Next

Range("A:A,E:E,K:K").HorizontalAlignment = xlRight
Range("B:D,G:H,L:L").HorizontalAlignment = xlCenter
Range("A1:L1").Interior.ColorIndex = 35
Range("A1:L1").Font.Bold = True
Range("A:L").Columns.AutoFit
End Sub
Download:   vba097.zip
relevante Links:

top