Dateieigenschaften auslesen?

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

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

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

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

Beliebteste Forumthreads (12 Monate)

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

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread