Option Explicit
' ---------------------------------------------------------
' Funktion: ReadExtendedInfos
' Eingestellt von: Andre Schau
' Datum: 5. Juno 2006
' Kommentar:
' Parameter: strPath, strFile und sType optional
' Rückgabe: Erfolg: FileName, ansonsten False
' Aufruf:
Sub ReadExtendFileInfo()
' Ausgabebereich identisch, für unterschiedliche Bereiche
' Parameter in Function erweitern!
'Variablendeklarationen
'Variant
Dim OkFunction
'einzelnes File
OkFunction = ReadExtendedInfos("C:\test\", "test1.txt")
'Verzeichnis
OkFunction = ReadExtendedInfos("C:\test\")
End Sub
' ---------------------------------------------------------
Private Function ReadExtendedInfos(ByVal strPath As Variant, _
Optional ByVal strFile As Variant = "", _
Optional ByVal sType As Variant = "") As Variant
ReadExtendedInfos = False
'Variablendeklarationen
'Objektvariable
Dim objShell As Object, objFolder As Object
'Integervariable
Dim iCounter%, iRow%, iCol%
'Variable für Files
Dim strFileName As Variant
'Arrayvariable - 34 Eigenschaften
Dim arrHeaders(34)
'Flackern aus
Application.ScreenUpdating = False
'Eingangsparameter prüfen
If strFile <> "" And sType <> "" Then
ReadExtendedInfos = "Bitte nur File oder Type angeben!"
Exit Function
End If
'Pfad bei Bedarf Backslash hinzufügen
If Right(strPath, 1) <> "\" Then strPath = strPath & "\"
'Shell setzen
Set objShell = CreateObject("Shell.Application")
'Ordner setzen
Set objFolder = objShell.Namespace(strPath)
Set strFileName = objFolder.parsename(strFile)
'Schleifenvariablen festlegen
iRow = 3 'Startzeile der Ausgabe
iCol = 1 'Ausgabespalte
'Bezeichner festlegen
For iCounter = 0 To 33
arrHeaders(iCounter) = objFolder.getdetailsof(objFolder, iCounter)
Next iCounter
If Not strFileName Is Nothing Then
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
Else
For Each strFileName In objFolder.items
'Anzeige des Eigenschaftsdialoges
'strFileName.invokeverb "E&igenschaften"
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 'Startzeile für nächste Datei
Next strFileName
End If
'Flackern ein
Application.ScreenUpdating = True
ReadExtendedInfos = True
End Function