Gruppe
Datei
Problem
In Spalte B werden die Eigenschaften des in Zelle B1 genannten Ordners eingetragen.
StandardModule: Modul1
Sub ReadProperties()
Dim Wscript As Application
Dim objWMIService As Object
Dim colFolders As Object
Dim objFolder As Object
Dim strComputer As String, sPath As String
sPath = Range("B1").Value
sPath = WorksheetFunction.Substitute(sPath, "\", "\\")
strComputer = "."
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colFolders = objWMIService. _
ExecQuery("Select * from Win32_Directory where name = '" & sPath & "'")
For Each objFolder In colFolders
With objFolder
Cells(3, 2).Value = .Archive
Cells(4, 2).Value = .Caption
Cells(5, 2).Value = .Compressed
Cells(6, 2).Value = .CompressionMethod
Cells(7, 2).Value = .CreationDate
Cells(8, 2).Value = .Encrypted
Cells(9, 2).Value = .EncryptionMethod
Cells(10, 2).Value = .Hidden
Cells(11, 2).Value = .InUseCount
Cells(12, 2).Value = .LastAccessed
Cells(13, 2).Value = .LastModified
Cells(14, 2).Value = .Name
Cells(15, 2).Value = .Path
Cells(16, 2).Value = .Readable
Cells(17, 2).Value = .System
Cells(18, 2).Value = .Writeable
End With
Next
End Sub