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