Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1732to1736
1732to1736
Aktuelles Verzeichnis
Verzeichnis Übersicht
Verzeichnis Übersicht
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Dateieigenschaften auslesen?

Forumthread: Dateieigenschaften auslesen?

Dateieigenschaften auslesen?
05.01.2020 00:54:21
Sergej
Hallo Leute,
ich habe in Zelle A3 bis A20 insgesamt 17 Verzeichnispfade Bsp. F:\Daten\Projekte\Service\2019\Berlin\M-BMS\ stehen. In den Spalten B und C möchte ich von letzter geänderte XLS-Datei aus dem Verzeichnis die Dateieigenschaften Datum (JJJJ-MM-TT) und „Zuletzt geändert von“ auslesen.
Wie mache ich das bitte per VBA?
Beste Grüße,
Sergej
Anzeige

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Dateieigenschaften auslesen?
05.01.2020 13:27:19
Nepumuk
Hallo Sergej,
teste mal:
Option Explicit

Public Sub LastModified()
    Dim lngRow As Long
    Dim dtmLastModifiedDate As Date, dtmMaxDate As Date
    Dim strPath As String, strFilename As String
    Dim objCollection As Collection
    Dim objWorkbook As Workbook
    Application.ScreenUpdating = False
    For lngRow = 3 To 20
        dtmMaxDate = 0
        Set objCollection = New Collection
        strPath = Cells(lngRow, 1).Value
        If Right$(strPath, 1) <> "\" Then strPath = strPath & "\"
        strFilename = Dir$(PathName:=strPath & "*.xls*")
        Do Until strFilename = vbNullString
            dtmLastModifiedDate = FileDateTime(PathName:=strPath & strFilename)
            dtmMaxDate = Application.Max(dtmMaxDate, dtmLastModifiedDate)
            Call objCollection.Add(Item:=strFilename, Key:=CStr(dtmLastModifiedDate))
            strFilename = Dir$
        Loop
        Set objWorkbook = GetObject(PathName:=strPath & objCollection.Item(Index:=CStr(dtmMaxDate)))
        Cells(lngRow, 2).Value = dtmMaxDate
        Cells(lngRow, 3).Value = objWorkbook.BuiltinDocumentProperties.Item("Last author").Value
        Call objWorkbook.Close(SaveChanges:=False)
        Set objWorkbook = Nothing
        Set objCollection = Nothing
    Next
    Application.ScreenUpdating = True
End Sub

Gruß
Nepumuk
Anzeige
AW: Dateieigenschaften auslesen?
05.01.2020 13:44:40
Sergej
Hallo Nepumuk,
ich habe es getestet und bekomme diese Meldung:
"Dieser Schlüssel ist bereits einem Element dieser Auflistung zugeordnet (Fehler 457)" in dieser Zeile:
Call objCollection.Add(Item:=strFilename, Key:=CStr(dtmLastModifiedDate))
Beste Grüße,
Sergej
AW: Dateieigenschaften auslesen?
05.01.2020 14:07:04
Nepumuk
Hallo Sergej,
teste damit:
Option Explicit

Public Sub LastModified()
    Dim lngRow As Long
    Dim dtmLastModifiedDate As Date, dtmMaxDate As Date
    Dim strPath As String, strFilename As String
    Dim enmAutomationSecurity As MsoAutomationSecurity
    Dim objDictionary As Object
    Dim objWorkbook As Workbook
    With Application
        .ScreenUpdating = False
        enmAutomationSecurity = .AutomationSecurity
        .AutomationSecurity = msoAutomationSecurityForceDisable
    End With
    Set objDictionary = CreateObject(Class:="Scripting.Dictionary")
    For lngRow = 3 To 20
        dtmMaxDate = 0
        strPath = Cells(lngRow, 1).Value
        If Right$(strPath, 1) <> "\" Then strPath = strPath & "\"
        strFilename = Dir$(PathName:=strPath & "*.xls*")
        Do Until strFilename = vbNullString
            dtmLastModifiedDate = FileDateTime(PathName:=strPath & strFilename)
            dtmMaxDate = Application.Max(dtmMaxDate, dtmLastModifiedDate)
            If Not objDictionary.Exists(Key:=CStr(dtmLastModifiedDate)) Then _
                Call objDictionary.Add(Key:=CStr(dtmLastModifiedDate), Item:=strFilename)
            strFilename = Dir$
        Loop
        Set objWorkbook = GetObject(PathName:=strPath & objDictionary.Item(Key:=CStr(dtmMaxDate)))
        Cells(lngRow, 2).Value = dtmMaxDate
        Cells(lngRow, 3).Value = objWorkbook.BuiltinDocumentProperties.Item("Last author").Value
        Call objWorkbook.Close(SaveChanges:=False)
        Call objDictionary.RemoveAll
    Next
    Set objWorkbook = Nothing
    Set objDictionary = Nothing
    With Application
        .ScreenUpdating = True
        .AutomationSecurity = enmAutomationSecurity
    End With
End Sub

Gruß
Nepumuk
Anzeige
AW: Dateieigenschaften auslesen?
05.01.2020 14:59:34
Sergej
Hallo Nepumuk,
funktionier perfekt. Vielen herzlichen Dank!
Eine Frage noch: Lässt sich in diesem Makro auch das Attribut "Zuletzt geändert von" ergänzen?
Sub DateiEigenschaften()
Dim FSO As Object
Dim file As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
Set file = FSO.GetFile("F:\Daten\Projekte\Service\2019\Berlin\M-BMS\stratos.xls")
Debug.Print "Attribute: " & file.Attributes
Debug.Print "erstellt am: " & file.DateCreated
Debug.Print "letzter Zugriff: " & file.DateLastAccessed
Debug.Print "letzte Bearbeitung: " & file.DateLastModified
Debug.Print "Laufwerk: " & file.Drive
Debug.Print "Name ohne Pfad: " & file.Name
Debug.Print "Übergeordneter Ordner: " & file.ParentFolder
Debug.Print "Vollständiger Pfad: " & file.Path
Debug.Print "MS-DOS-Ordnername: " & file.ShortName
Debug.Print "MS-DOS-Pfad: " & file.ShortPath
Debug.Print "Gesamtgröße: " & FormatNumber(file.Size, 0) & " KB"
Debug.Print "Dateityp: " & file.Type
End Sub
Beste Grüße,
Sergej
Anzeige
AW: Dateieigenschaften auslesen?
05.01.2020 15:14:00
Nepumuk
Hallo Sergej,
nein, denn das ist eine spezifische Eigenschaft von Office-Dokumenten. Das FileSystemObject kann nur Standardeigenschaften auslesen.
Spezifische Office-Dateieigenschaften kannst du mit der DSOFile-Klasse auslesen. Aber dazu müsstest du eine DLL installieren.
Gruß
Nepumuk
Anzeige
Okay ;-) o.wT
05.01.2020 16:38:30
Sergej
;
Anzeige

Beliebteste Forumthreads (12 Monate)

Jetzt das Excel-Portal bewerten: Deine Stimme zählt!
Anzeige
Anzeige
Anzeige