Dateiliste mit Eigenschaften

Dirk · 1970-01-01T00:00:00+00:00

Hallo zusammen! Ich möchte über VBA eine Liste mit Excel-Dateien in einem frei wählbaren Verzeichnis erstellen. Das funktioniert ganz gut und ich kann in die Liste den Pfad, Dateinamen, Größe, .. eintragen. wks.Cells(iCounter + 1, 3).Value = Left(.FoundFiles(iCounter), InStrRev(.FoundFiles(iCounter), "\") - 1) 'Pfad wks.Cells(iCounter + 1, 4).Value = Mid(.FoundFiles(iCounter), _ InStrRev(.FoundFiles(iCounter), "\") + 1, Len(.FoundFiles(iCounter))) 'Dateiname wks.Cells(iCounter + 1, 5).Value = FileLen(.FoundFiles(iCounter)) 'Dateigröße wks.Cells(iCounter + 1, 6).Value = FileDateTime(.FoundFiles(iCounter)) 'letztes Speicherdatum Gibt es eine Möglichkeit, den Code so zu erweitern, das auch weitere Dateieigenschaften in den nächsten Spalten angezeigt werden, oder kann man auf die Dateieigenschaften nur in einer geöffneten Datei zugreifen? Vielen Dank schomal für Eure Anregungen Dirk

Hallo Dirk,
hier mal ein Macro um durch alle Dateien durchzugehen:


Sub ListAllFile()
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim ws As Worksheet
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set ws = Worksheets.Add
'Get the folder object associated with the directory   !!! Hier das Laufwerk und den  _
Verzeichnispfad setzen
Set objFolder = objFSO.GetFolder("C:\")
'  !!!!  und hier noch die Zelle ab welcher die Dateinamen eingetragen werden sollen  Cells( _
Zeile, Spalte)
ws.Cells(1, 1).Value = "The files found in " & objFolder.Name & "are:"
'Loop through the Files collection
For Each objFile In objFolder.Files
if lcase(right(objfile.name,3)) = "xls" then
'hier den Dateityp festlegen, falls 4stellig 3 auf 4 aendern!!
ws.Cells(ws.UsedRange.Rows.Count + 1, 1).Value = objFile.Name
'weitere eigenschaften:
'objFile.name
'objFile.Size
'objFile.Type
'objFile.DateCreated
'objFile.DateLastAccessed
'objFile.DateLastModified
'objFile.Attributes
'objFile.ShortPath
'objFile.ShortName
end if
Next
'Clean up!
Set objFolder = Nothing
Set objFile = Nothing
Set objFSO = Nothing
End Sub

Du kannst alle Eigenschaften in verschiedene Zellen eintragen.
Lass' horen, ob hilfreich.
Gruss
Dirk aus Dubai

Hallo,
ein Beispiel zu weiterbasteln:


Public Sub Beispiel()
    
    Const FILE_FOLDER = "D:\Eigene Dateien\Eigene Tabellen\"
    Const FILE_PROPERTY = "Kommentare"
    Const FILE_NAME = "*.xls"
    Const MAX_PROPERTYS = 255
    
    Dim objShell As Object, objFolder As Object
    Dim strFile As String
    Dim lngIndex As Long, lngPosition As Long, lngRow As Long
    
    ' initialize errorhandler
    On Error GoTo error_exit
    
    ' verify folder exit
    If Dir$(FILE_FOLDER, vbDirectory) = "" Then _
        Err.Raise Number:=vbObjectError, Description:="Ordner ''" & FILE_FOLDER & "'' nicht gefunden."
    
    ' create object
    Set objShell = CreateObject(Class:="Shell.Application")
    
    ' set reverence to folder
    Set objFolder = objShell.Namespace((FILE_FOLDER))
    
    ' search position of fileproperty
    For lngIndex = 0 To MAX_PROPERTYS
        If Trim$(objFolder.GetDetailsOf("", lngIndex)) <> "" Then
            If Cbool(InStr(FILE_PROPERTY, objFolder.GetDetailsOf("", lngIndex))) Then
                lngPosition = lngIndex
                Exit For
            End If
        End If
    Next
    
    ' property not found - trigger an error
    If lngPosition = 0 Then _
        Err.Raise Number:=vbObjectError, Description:="Dateieigenschaft ''" & _
        FILE_PROPERTY & "'' nicht gefunden."
    
    ' get first file
    strFile = Dir$(FILE_FOLDER & FILE_NAME, vbNormal)
    
    ' loop over all files
    Do While strFile <> ""
        
        ' counter for rows in table
        lngRow = lngRow + 1
        
        ' write filename and property to table
        With Tabelle1
            .Cells(lngRow, 1).Value = strFile
            .Cells(lngRow, 2).Value = objFolder.GetDetailsOf( _
                objFolder.ParseName(strFile), lngPosition)
        End With
        
        ' get next file
        strFile = Dir$
        
    Loop
    
    Tabelle1.Columns.AutoFit
    
    sub_exit:
    
    ' clear objects
    Set objShell = Nothing
    Set objFolder = Nothing
    
    Exit Sub
    
    error_exit:
    
    ' show errormessage
    MsgBox "Fehler: " & CStr(Err.Number) & vbLf & vbLf & _
        Err.Description, vbCritical, "Fehler"
    Resume sub_exit
    
End Sub

In Unterordner kommst du mit Dir$ natürlich nicht, aber dazu gibt es ja mehrere Alternativen.
Gruß
Nepumuk

Forumthread: Dateiliste mit Eigenschaften

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Infobox / Tutorial