Hallo
ich habe auf dir schnelle in meinem Archiv zwei Makros gefunden. Kann aber nicht garantieren ob das Schreiben klappt? Probier es bitte selbst aus.
mfg Nobody
Sub Write_Properties()
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
.Archive = Cells(3, 2).Value
.Caption = Cells(4, 3).Value
.Compressed = Cells(5, 2).Value
.CompressionMethod = Cells(6, 2).Value
.CreationDate = Cells(7, 2).Value
.Encrypted = Cells(8, 2).Value
.EncryptionMethod = Cells(9, 2).Value
.Hidden = Cells(10, 2).Value
.InUseCount = Cells(11, 2).Value
.LastAccessed = Cells(12, 2).Value
.LastModified = Cells(13, 2).Value
.Name = Cells(14, 2).Value
.Path = Cells(15, 2).Value
.Readable = Cells(16, 2).Value
.System = Cells(17, 2).Value
.Writeable = Cells(18, 2).Value
End With
Next
End Sub
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
|