Thema: Dateiinformationen auslesen

Geben Sie den nachfolgenden Code in ein Standardmodul ein und weisen Sie ihn einer Schaltfläche zu.

StandardModule: Modul1

Sub ReadProperties()
   Dim objWMIService As Object
   Dim colFiles As Object
   Dim objFile As Object
   Dim strPath As String, strComputer As String
   strPath = Range("B1").Value
   If Dir(strPath) = "" Then
      Beep
      MsgBox "Die Datei wurde nicht gefunden!"
      Exit Sub
   End If
   strPath = WorksheetFunction.Substitute(strPath, "\", "\\")
   strComputer = "."
   Set objWMIService = GetObject("winmgmts:" _
      & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
   Set colFiles = objWMIService.ExecQuery _
      ("Select * from CIM_Datafile Where name = '" & strPath & "'")
   For Each objFile In colFiles
      With objFile
         Cells(3, 2).Value = .AccessMask
         Cells(4, 2).Value = .Archive
         Cells(5, 2).Value = .Compressed
         Cells(6, 2).Value = .CompressionMethod
         Cells(7, 2).Value = .CreationDate
         Cells(8, 2).Value = .CSName
         Cells(9, 2).Value = .Drive
         Cells(10, 2).Value = .EightDotThreeFileName
         Cells(11, 2).Value = .Encrypted
         Cells(12, 2).Value = .EncryptionMethod
         Cells(13, 2).Value = .Extension
         Cells(14, 2).Value = .Filename
         Cells(15, 2).Value = .FileSize
         Cells(16, 2).Value = .FileType
         Cells(17, 2).Value = .FSName
         Cells(18, 2).Value = .Hidden
         Cells(19, 2).Value = .LastAccessed
         Cells(20, 2).Value = .LastModified
         Cells(21, 2).Value = .Manufacturer
         Cells(22, 2).Value = .Name
         Cells(23, 2).Value = .Path
         Cells(24, 2).Value = .Readable
         Cells(25, 2).Value = .System
         Cells(26, 2).Value = .Version
         Cells(27, 2).Value = .Writeable
      End With
   Next objFile
End Sub

Beiträge aus dem Excel-Forum zu den Themen Extern und winmgmts