Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1216to1220
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Dateieigenschaften abfragen

Dateieigenschaften abfragen
LotharP
Hallo zusammen,
ich habe einen Code der mir aus einem VErzeichnis die Dateien auflistet und dazu schreibe ich mir ein paar Dateiinfos raus.
  • For Each AITEM In pcurrentdir.Files
    SONGNAME = Left(AITEM.Name, Len(AITEM.Name) - 4)
    HYPENAME = VORBELEG & "\" & AITEM.Name
    DATTYP = Right(AITEM.shortname, 3)
    SLFIND = InStrRev(VORBELEG, "\", -1) + 1
    ONAME = Mid(VORBELEG, SLFIND, Len(VORBELEG) - (SLFIND - 1))
    ActiveSheet.Hyperlinks.Add Anchor:=Cells(lngAkt + 4, 1), Address:=HYPENAME, TextToDisplay:=SONGNAME
    Cells(lngAkt + 4, 2) = VORBELEG
    Cells(lngAkt + 4, 3) = AITEM.datecreated
    Cells(lngAkt + 4, 4) = AITEM.Size
    Cells(lngAkt + 4, 5) = ONAME
    Cells(lngAkt + 4, 6) = DATTYP
    'Cells(lngAkt + 4, 7) = AITEM.Author
    'Cells(lngAkt + 4, 8) = AITEM.bitrate
    Cells(lngAkt + 4, 9) = AITEM.datelastmodified
    lngAkt = lngAkt + 1
    Next

  • Mir fehlen jetzt diverse Dateiinfos (fett markiert), ich weiss aber nicht wie ich die ansprechen soll!
    Einen Source den ich im Netz gefunden habe wäre eine Alternative, allerdings bin ich überrascht warum der funktioniert!? Also besser: DEN VERSTEH ICH NUN GAR NICHT MEHR!
  • 
    Public Sub test()
    Const STRFOLDER As String = "E:\PRI\SONGS\RESTMUCKE"
    Dim ObjShell As Object, ObjFolder As Object
    Dim BYTINDEX As Byte, intColumn As Integer, lngRow As Long
    Dim varName ', arrHeaders(37)
    If Dir(STRFOLDER, 16) = "" Then
    MsgBox "Der Ordner " & STRFOLDER & " wurde nicht gefunden!", 64, "Hinweis"
    Exit Sub
    End If
    Application.ScreenUpdating = False
    Set ObjShell = CreateObject("Shell.Application")
    Set ObjFolder = ObjShell.Namespace(STRFOLDER)
    intColumn = 1
    '    For BYTINDEX = 0 To 37
    '        arrHeaders(BYTINDEX) = objFolder.GetDetailsOf(varName, BYTINDEX)
    '        Cells(1, intColumn + BYTINDEX) = arrHeaders(BYTINDEX)
    '    Next
    '    Rows(1).Font.Bold = True
    lngRow = 2
    For Each varName In ObjFolder.Items
    For BYTINDEX = 0 To 37
    Cells(lngRow, intColumn + BYTINDEX) = ObjFolder.GetDetailsOf(varName, BYTINDEX)
    Next
    lngRow = lngRow + 1
    Next
    Columns.AutoFit
    Set ObjShell = Nothing
    Set ObjFolder = Nothing
    Application.ScreenUpdating = True
    End Sub
    

  • Er ist weitaus einfacher als der den ich nutze und listet direkt alles auf, das will ich zwar nicht, aber ich hatte mir erhofft er würde mir die Dateieigenschaftsnamen wie "DATECREATED" oder "SIZE" liefern, statt dessen gibt er GRÖSSE UND LETZTER ZUGRIFF.
    Das verstehe ich nicht! Builtinproperties hat mich jetzt auch nicht weitergebracht!
    Wie gesagt mein Code funktioniert und ich würde gerne dort aufsetzen, den anderen Code aber auch gerne verstehen.
    Wäre nett wenn mir jemand helfen könnte!
    Vielen Dank und V.G. aus dem verregneten Köln.
    Gruß
    Lothar

    5
    Beiträge zum Forumthread
    Beiträge zu diesem Forumthread

    Betreff
    Benutzer
    Anzeige
    Dateieigenschaften abfragen
    31.05.2011 17:31:24
    Anton
    Hallo Lothar,
    probier sowas:
    Code:

    Dim i As Long  
    Sub dateien_auflisten()
      Dim objShell, objFolder
      Dim BrowseDir, varName
      Set objShell = CreateObject("Shell.Application")  
      Set BrowseDir = objShell.BrowseForFolder(0, "Ordner auswählen", &H1000, 17)  
      If Not BrowseDir Is Nothing Then    
        Application.ScreenUpdating = False
        Cells.Clear
        i = 0
        Set objFolder = objShell.Namespace(BrowseDir.items().Item().Path)
        i = i + 1
        Cells(i, 1) = "Hyperlink"
        Cells(i, 2) = "BaseName"
        Cells(i, 3) = "ExtensionName"
        spalte = 4
        For k = 1 To 50  
          If objFolder.GetDetailsOf(, k) = "Erstellt am" Then  
            Cells(i, spalte) = objFolder.GetDetailsOf(, k)
            spalte = spalte + 1
          ElseIf objFolder.GetDetailsOf(, k) = "Geändert am" Then    
            Cells(i, spalte) = objFolder.GetDetailsOf(, k)
            spalte = spalte + 1
          ElseIf objFolder.GetDetailsOf(, k) = "Größe" Then    
            Cells(i, spalte) = objFolder.GetDetailsOf(, k)
            spalte = spalte + 1
          ElseIf objFolder.GetDetailsOf(, k) = "Autor" Then    
            Cells(i, spalte) = objFolder.GetDetailsOf(, k)
            spalte = spalte + 1
          ElseIf objFolder.GetDetailsOf(, k) = "Bitrate" Then    
            Cells(i, spalte) = objFolder.GetDetailsOf(, k)
            spalte = spalte + 1
          End If  
        Next
        Set objFolder = Nothing  
        If MsgBox("Unterordner duchsuchen?", vbYesNo, "Abfrage") = vbYes Then  
          rekursiv BrowseDir.items().Item().Path, True
        Else
          rekursiv BrowseDir.items().Item().Path, False
        End If  
        Application.ScreenUpdating = True
        Columns.AutoFit
      End If  
      Set objShell = Nothing  
    End Sub  
    Function rekursiv(ordner, unterordner As Boolean)  
      Set objShell = CreateObject("Shell.Application")  
      Set objFolder = objShell.Namespace(ordner)
      For Each varName In objFolder.items  
        If varName.Type = "Dateiordner" And unterordner = True Then    
          rekursiv varName.Path, True
        ElseIf varName.Type <> "Dateiordner" Then    
          i = i + 1
          basename = Left(varName.Name, InStrRev(varName.Name, ".") - 1)
          ActiveSheet.Hyperlinks.Add Anchor:=Cells(i, 1), Address:=varName.Path, TextToDisplay:=basename
          Cells(i, 2) = basename
          Cells(i, 3) = Mid(varName.Name, InStrRev(varName.Name, ".") + 1)
          spalte = 4
          For k = 1 To 50  
            If objFolder.GetDetailsOf(, k) = "Erstellt am" Then  
              Cells(i, spalte) = objFolder.GetDetailsOf(varName, k)
              spalte = spalte + 1
            ElseIf objFolder.GetDetailsOf(, k) = "Geändert am" Then    
              Cells(i, spalte) = objFolder.GetDetailsOf(varName, k)
              spalte = spalte + 1
            ElseIf objFolder.GetDetailsOf(, k) = "Größe" Then    
              Cells(i, spalte) = objFolder.GetDetailsOf(varName, k)
              spalte = spalte + 1
            ElseIf objFolder.GetDetailsOf(, k) = "Autor" Then    
              Cells(i, spalte) = objFolder.GetDetailsOf(varName, k)
              spalte = spalte + 1
            ElseIf objFolder.GetDetailsOf(, k) = "Bitrate" Then    
              Cells(i, spalte) = objFolder.GetDetailsOf(varName, k)
              spalte = spalte + 1
            End If  
          Next
        End If  
      Next
      Set objFolder = Nothing  
    End Function  


    mfg Anton
    Anzeige
    AW: Dateieigenschaften abfragen
    01.06.2011 12:17:06
    LotharP
    Hallo Anton,
    zunächst mal vielen Dank für deine Mühe!
    Der Code läuft auf einen Fehler, keine Ahnung warum. Er durchlaüft ein paarmal die Schleife, listet alles brav auf und läuft dann auf einen Fehler.
    Das ist aber nicht das Problem, ich denke den von mir angegebenen 2ten Code hätte ich auch verändern können und würde so zu meinem Ergebnis kommen. Allerdings hab' ich ihn wirklich nicht verstanden!
    (Auch dein Code geht über meine Kenntnis weit hinaus!) ;-)
    Die eigentliche Frage ist: WIE HEISSEN DIE Felder, denn in dem ersten Source den ich benutze gibt es ein DATECREATED.
    Der Dateiname steht bei mir in AITEM, als Objekt deklariert.
    Mein von mir erster aufgeführter Code funktioniert ja auch, ich weiss nur eben nicht wie ich die bezeichner rauskriege.
    Du scheinst das ja hier abzufragen:
  • If objFolder.GetDetailsOf(, k) = "Erstellt am" Then
    Cells(i, spalte) = objFolder.GetDetailsOf(, k)

  • aber in dem von mir verwendeten Code steht:
  • For Each AITEM In pcurrentdir.Files
    SONGNAME = Left(AITEM.Name, Len(AITEM.Name) - 4)
    HYPENAME = VORBELEG & "\" & AITEM.Name
    DATTYP = Right(AITEM.shortname, 3)
    SLFIND = InStrRev(VORBELEG, "\", -1) + 1
    ONAME = Mid(VORBELEG, SLFIND, Len(VORBELEG) - (SLFIND - 1))
    ActiveSheet.Hyperlinks.Add Anchor:=Cells(lngAkt + 4, 1), Address:=HYPENAME, TextToDisplay:=SONGNAME
    Cells(lngAkt + 4, 2) = VORBELEG
    Cells(lngAkt + 4, 3) = AITEM.datecreated
    Cells(lngAkt + 4, 4) = AITEM.Size
    Cells(lngAkt + 4, 5) = ONAME
    Cells(lngAkt + 4, 6) = DATTYP
    Cells(lngAkt + 4, 9) = AITEM.datelastmodified
    lngAkt = lngAkt + 1
    Next

  • Ich verstehe das nicht!Wär nett wenn du dran bliebest.
    Vielen Dank und V.G.
    Lothar
    Anzeige
    Dateieigenschaften abfragen / Fehler
    01.06.2011 13:41:48
    LotharP
    Hallo Anton,
    den Fehler habe ich gefunden, beim Durchlaufen der Schleife fragst du in der Funktion REKURSIV ab ob es ein Folder ist oder nicht.
    Ich habe Unterordner in dem Verzeichnis will diese aber nicht durchlaufen lassen!!
    Und der Ordner den ich habe heisst RESTMUSIK und kommt nach MRS ROBINSON, ändere ich den Ordner auf ZREST dann läuft er durch bis Z und erst dann auf einen Fehler.
    Die ganze ELSEIF fasse ich aber lieber nicht an! ;-)
    Ich werde immer mal wieder reinschauen und hoffe du bleibst dran!
    Danke und wenn wir uns hier nicht mehr lesen einen schönen VATERTAG! ;-)
    Gruß
    Lothar
    Anzeige
    Dateieigenschaften abfragen / Fehler
    01.06.2011 17:40:30
    Anton
    Hallo Lothar,
    in deinem ersten Code benutzt du Scripting.FileSystemObject.Dieses Object kennt aber keine Eigenschaften wie Autor oder Bitrate usw.
    Im zweiten Code wird Shell.Application Object benutzt.Dieses Object kann alle Eigenschaften einer Datei auflisten.
    er würde mir die Dateieigenschaftsnamen wie "DATECREATED" oder "SIZE" liefern, statt dessen gibt er GRÖSSE UND LETZTER ZUGRIFF. 
    

    DATECREATED = Erstellt am , SIZE = GRÖSSE , datelastmodified = Geändert am
    Ich habe Unterordner in dem Verzeichnis will diese aber nicht durchlaufen lassen!!
    

    dann musst du bei der MsgBox auf 'Nein' klicken.
    Der Code läuft auf einen Fehler ...
    

    Welchen?
    mfg Anton
    Anzeige
    AW: Dateieigenschaften abfragen / Fehler
    03.06.2011 12:22:23
    LotharP
    Hallo Anton,
    hmm, das ist dann die Antwort! Gut Danke, ich dachte das FSO würde das Gleiche machen wie Shell und alle Infos mitgeben!
    dann musst du bei der MsgBox auf 'Nein' klicken.
    

    Klar, NEIN hab' ich auch gedrückt. Das Problem ist, er durchläuft die Dateien alphabetisch! Wenn er auf einen Ordnernamen stößt behandelt er diesen als Datei und läuft auf den Fehler, egal ob ich nein gedrückt habe oder nicht.
    Der Fehler ist LZF 5, ungültiger Prozeduraufruf.....
    Und zwar hierbei:
  • Function rekursiv(ordner, unterordner As Boolean)
    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.Namespace(ordner)
    For Each varName In objFolder.items
    If varName.Type = "Dateiordner" And unterordner = True Then
    rekursiv varName.Path, True
    ElseIf varName.Type "Dateiordner" Then
    i = i + 1
    basename = Left(varName.Name, InStrRev(varName.Name, ".") - 1)

  • Aber ich denke ich werde deinen CODE einbauen und meinen alten über den Haufen schmeissen, denn ich möchte ja eventuell um Dateiinfos erweitern. Den Fehler müsste ich abfangen, ich werds mal versuchen.
    Vielen DAnk nochmal für deine Mühe und ich wünsch dir ein schönes WE!
    Gruß aus dem sonnigen Köln!
    Lothar
    Anzeige

    Beliebteste Forumthreads (12 Monate)

    Anzeige

    Beliebteste Forumthreads (12 Monate)

    Anzeige
    Anzeige
    Anzeige