Option
Explicit
Sub
Enhets_Information()
'© 2003
Alla rättigheter XL-Dennis
Dim
fsoObj
As
Scripting.FileSystemObject
Dim
fsoDrv
As
Scripting.Drive
Dim
i
As
Long
Set
fsoObj =
New
Scripting.FileSystemObject
With
ActiveSheet
With
.Range("A1:H1")
.Value =
VBA.Array("Enhetstyp",
"Enhetsbokstav",
"Enhetsnamn",
_
"Serienummer",
"Utdelad enhetsnamn",
"Filsystem",
_
"Storlek
(GB)",
"Ledigt utrymme")
.Font.Bold =
True
End
With
End
With
i =
1
For
Each
fsoDrv In fsoObj.Drives
With
fsoDrv
'Enklare felhantering ifall diskettstation eller CD-ROM o d
'är
tomma.
On
Error
Resume
Next
'Här
väljs vilken mediatyp enheten är.
Select
Case
.DriveType
Case
0:
Cells(i +
1,
1).Value
=
"Okänd"
Case
1:
Cells(i +
1,
1).Value
=
"Diskettstation"
Case
2:
Cells(i +
1,
1).Value
=
"Hårddisk"
Case
3:
Cells(i +
1,
1).Value
=
"Nätverksdisk"
Case
4:
Cells(i +
1,
1).Value
=
"CD-ROM
o d"
Case
5:
Cells(i +
1,
1).Value
=
"RAM-disk"
End
Select
Cells(i +
1,
2).Value
= .DriveLetter
Cells(i +
1,
3).Value
= .VolumeName
Cells(i +
1,
4).Value
= .SerialNumber
Cells(i +
1,
5).Value
= .ShareName
Cells(i +
1,
6).Value
= .FileSystem
Cells(i +
1,
7).Value
=
CLng(.TotalSize
/
1073741824)
Cells(i +
1,
8).Value
=
CLng(.FreeSpace
/
1073741824)
End
With
i
= i +
1
NextDrv:
Next
fsoDrv
ActiveSheet.Columns("A:H").AutoFit
Set
fsoObj =
Nothing
Set
fsoDrv =
Nothing
End
Sub