Microsoft Excel

Excel und VBA: Formeln, Programmierung, Lösungen

Die Excel/VBA-Beispiele

Thema

Dateiinformationen auslesen

Gruppe

winmgmts

Problem

Die Dateiinformationen der in Zelle B1genannten Datei sollen ausgelesen werden.

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

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