Gruppe
Datei
Problem
Die Dateiheaderinformationen der sich im in Zelle B1 genannten Verzeichnis befindlichen Dateien sollen aufgelistet werden.
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