Thema: Dateiheaderinformationen abrufen

StandardModule: Modul1

Sub ExtendedInfos()
   Dim objShell As Object
   Dim objFolder As Object
   Dim iCounter As Integer, iRow As Integer, iCol As Integer
   Dim strFileName As Variant
   Dim arrHeaders(34)
   Application.ScreenUpdating = False
   Set objShell = CreateObject("Shell.Application")
   Set objFolder = objShell.Namespace(Range("B1").Value)
   iRow = 3
   iCol = 1
   For iCounter = 0 To 33
      arrHeaders(iCounter) = _
         objFolder.GetDetailsOf(objFolder.Items, iCounter)
   Next iCounter
   For Each strFileName In objFolder.Items
      For iCounter = 0 To 33
         Cells(iRow + iCounter, 1).Value = iCounter + 1
         Cells(iRow + iCounter, 2).Value = arrHeaders(iCounter)
         Cells(iRow + iCounter, 3).Value = _
            objFolder.GetDetailsOf(strFileName, iCounter)
      Next iCounter
      iRow = iRow + 35
   Next strFileName
   Application.ScreenUpdating = True
End Sub

Beiträge aus dem Excel-Forum zu den Themen Datei und Verzeichnis