Supportnet Computer
Planet of Tech

Supportnet / Forum / Tabellenkalkulation

Erstelldatum von Dateien in eine Tabellenspalte übertragen.





Frage

Hallo, ich möchte gerne das Erstelldatum von Dateien in einem Verzeichnis mittels VBA in eine Tabellenspalte eintragen lassen. Dabei habe ich bereits mit unten angegebenen VBA-Code versucht: Sub Dateinamenliste_Aus_Verzeichnis() Dim strPath As String Dim strFile As String Dim i As Integer Range("A1").Select i = 0 strPath = InputBox("Geben Sie bitte den Verzeichnispfad vollständig an", "Verzeichnispfad", "C:\") If Right(strPath, 1) <> "\" Then strPath = strPath & "\" End If strFile = Dir(strPath, vbDirectory) Do Until strFile = "" If strFile <> "." And strFile <> ".." Then Cells(i + 1, 1).Value = strFile Cells(i + 1, 2).Value = FileDateTime(strPath & strFile) i = i + 1 End If strFile = Dir Loop End Sub Leider ohne den gewünschten Erfolg, da die Funktion "FileDateTime" immer das Datum der letzten Änderung zurückgibt und nicht das tatsächliche Erstelldatum. Wer kann mir dabei weiterhelfen? Wäre wirklich toll, wenn jemand eine Lösung für mich hätte. MfG Reinhard

Antwort 1 von coros

Hallo Reinahrd,

ändere in Deinem Code in der Zeile

Cells(i + 1, 2).Value = FileDateTime(strPath & strFile) 


die Funktion

FileDateTime(strPath & strFile) 


gegen die Eigenschaft

BuiltinDocumentProperties("Creation Date")


Das liefert Dir das Erstelldatum aus den Eigenschaften.

MfG,
Oliver
Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du ein
Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.

Antwort 2 von exterm

Hallo Reinhard,

Ist es das, was Du suchst?

Sub Dateinamenliste_Aus_Verzeichnis()
Dim strPath As String
Dim strFile As String
Dim i As Integer

Dim fs, f

Range("A1").Select
i = 0
strPath = InputBox("Geben Sie bitte den Verzeichnispfad vollständig an", "Verzeichnispfad", "C:\")
If Right(strPath, 1) <> "\" Then
strPath = strPath & "\"
End If
strFile = Dir(strPath, vbDirectory)
Do Until strFile = ""
If strFile <> "." And strFile <> ".." Then
Cells(i + 1, 1).Value = strFile
Cells(i + 1, 2).Value = FileDateTime(strPath & strFile)

On Error Resume Next
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFile(strPath & strFile)
Cells(i + 1, 3).Value = f.dateCreated
On Error GoTo 0

i = i + 1
End If
strFile = Dir
Loop
End Sub


Gruß exterm

Antwort 3 von n-reinhard

Danke exterm,

Dein Lösungsvorschlag funktioniert bestens.

MfG
Reinhard

Ich möchte kostenlos eine Frage an die Mitglieder stellen:


Ähnliche Themen:


Suche in allen vorhandenen Beiträgen: