Datei Auslesen (Erstelldatum)
15.10.2015 22:58:59
Alex
ich benötige wieder eure Hilfe.
Ich muss ca. 3000 Daten aus einem Pfad auslesen.
Die Dateien können sich in verschiedene Ordner befinden, momentan benutze ich folgendes Macro das auch gut funktioniert.
In der dritten Spalte lese ich das Speicherdatum aus (FileDateTime) ich bräuchte aber das Erstelldatum und evtl. auch das Speicherdatum.
Hat jemand eine Idee ?
Vielen Dank im Voraus. :-)
Option Explicit
Dim z, unterordner As Variant
Sub Suchen_Data()
Dim Laufwerk, Dateien As String
z = 3
MsgBox "Das Aulesen dauert ca. 1,30 min "
Worksheets("Tabelle2").Select
Selection.ClearContents
[a1:AL65000] = ""
Laufwerk = ("F:\...\....")
If Laufwerk = "" Then Exit Sub
unterordner = vbYes
Dateien = "2015-*.jpg" '2015-*.jpg
If Dateien = "" Then Exit Sub
Dateisuche Laufwerk, Dateien
Worksheets("Tabelle1").Range("A9:G1253").ClearContents
'Worksheets("Tabelle1").Range("B9:G1253").ClearContents (Bereich Löschen)
End Sub
Sub Dateisuche(Laufwerk, Dateien)
Dim temp, wdhlg, Dateiname, Textzerlegen As String
On Error Resume Next
If Right(Laufwerk, 1) "\" Then Laufwerk = Laufwerk + "\"
temp = Dir(Laufwerk & Dateien)
Do While Len(temp)
Dateiname = Laufwerk & temp
Application.StatusBar = Dateiname
Cells(z, 1).Select
Cells(z, 1) = Laufwerk & temp
'Cells(z, 2) = FileLen(Laufwerk & temp)
Cells(z, 3) = FileDateTime(Laufwerk & temp)
Cells(z, 4) = temp
z = z + 1
temp = Dir()
Loop
temp = Dir(Laufwerk, vbDirectory)
If unterordner = vbNo Then temp = ""
Do While Len(temp)
If (temp ".") And (temp "..") Then
If (GetAttr(Laufwerk & temp) And vbDirectory) = vbDirectory Then
Dateisuche Laufwerk & temp, Dateien
z = z - 1
wdhlg = Dir(Laufwerk, vbDirectory)
z = z + 1
Do While wdhlg temp
wdhlg = Dir()
Loop
End If
End If
temp = Dir()
Loop
On Error GoTo 0
End Sub