AW: Speichergrösse
16.01.2004 14:53:59
K.Rola
Hallo,
schießt zwar etwas übers Ziel hinaus, aber das kannst du ja beschränken:
''Verweis auf Microsoft Scripting Runtime erforderlich
Option Explicit
Sub laufwerk()
Dim objFSO As FileSystemObject, objDrive As Drive, z As Integer, DType As String
Set objFSO = New FileSystemObject
[a1] = "Laufwerksbuchstabe"
[b1] = "Laufwerkstyp"
[c1] = "Laufwerkstyp"
[d1] = "Gesamtspeicher GB"
[e1] = "Freier Speicher GB"
[f1] = "Pfad"
[g1] = "Ist bereit"
[h1] = "Wurzelverzeichnis"
[i1] = "Seriennummer"
[j1] = "Sharename"
[k1] = "Bezeichnung"
[L1] = "Dateisystem"
z = 1
For Each objDrive In objFSO.Drives
z = z + 1
Select Case objDrive.DriveType
Case 0: DType = "Unbekannter Typ"
Case 1: DType = "Wechseldatenträger"
Case 2: DType = "Festplatte"
Case 3: DType = "Remote"
Case 4: DType = "CD- Rom"
Case 5: DType = "RAM- Disk"
End Select
On Error Resume Next
Cells(z, 1) = objDrive.DriveLetter
Cells(z, 2) = DType
Cells(z, 3) = objDrive.DriveType
Cells(z, 4) = objDrive.TotalSize / 1024 / 1000
Cells(z, 5) = objDrive.FreeSpace / 1024 / 1000
Cells(z, 6) = objDrive.Path
Cells(z, 7) = objDrive.IsReady
Cells(z, 8) = objDrive.RootFolder
Cells(z, 9) = objDrive.SerialNumber
Cells(z, 10) = objDrive.ShareName
Cells(z, 11) = objDrive.VolumeName
Cells(z, 12) = objDrive.FileSystem
Next
[a1:l1].Orientation = 90
[a1:l1].HorizontalAlignment = xlCenter
With [a1:l100].Font
.Name = "Arial"
.FontStyle = "Fett"
.Size = 8
.ColorIndex = xlAutomatic
End With
[a2:l100].Font.Bold = False
Columns.AutoFit
End Sub
Gruß K.Rola