Letzte Änderung innerhalb eines Ordners

Public Sub Auslesen() Const STRFOLDER As String = "R:\Daten" 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

Beitrag zum Forumthread

Beitrag zu diesem Forumthread

Betreff

Benutzer

Hallo Steffen,
der Name des letzten Autors, wie er in Excel unter den Dokumenteigenschaften einer geöffneten Arbeitsmappe angezeigt wird, ist keiner der Werte, die man mit deinem Makro direkt auslesen kann, auch wenn es insgesamt ca. 280 Informationen gibt, die man zu verschiedenen Dateitypen auslesen kann.
Um die zuletzt bearbeitete Datei zu ermitteln kann man das Speicherdatum auswerten. Den Autor der letzten Änderung kann man nur ermitteln. indem man die Exceldatei öffnet und die Dokumenteigenschaft "Last Author" ausliest.
Wahrscheinlich kann man auch irgendwie über das Betriebssystem ermitteln, welcher User eine Datei bearbeitet hat. Da kenne ich mich aber nicht aus.
Gruß
Franz

Public Sub Auslesen()
'    Const STRFOLDER As String = "R:\Daten"
Const STRFOLDER As String = "C:\Users\Public\Test\Data"
Dim ZeileLetzte As Long, ZeitMax As Date, strDatei As String
Dim wb As Workbook, strName As String
Dim objShell As Object, objFolder As Object
Dim bytIndex As Byte, intColumn As Integer, lngRow As Long
Dim varName, arrHeaders(150)
If Dir(STRFOLDER, 16) = "" Then
MsgBox "Der Ordner " & STRFOLDER & " wurde nicht gefunden!", 64, "Hinweis"
Exit Sub
End If
ZeitMax = 0
Application.ScreenUpdating = False
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.Namespace(STRFOLDER)
intColumn = 1
For bytIndex = 0 To 150
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
If ZeitMax

Beliebteste Forumthreads (12 Monate)

Letzte Änderung innerhalb eines Ordners

1 Beitrag zum Forumthread Beitrag zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread