AW: Einlesen der letzten 7 Dateien in einem Ordner
26.11.2019 11:55:04
volti
Hallo Tobias,
nach Start des Makros wird das Verzeichnis nach den gewünschten Dateien durchsucht und die neuesten Dateien im Array abgelegt.
Anschließend können die Dateien aus dem Array nacheinander abgerufen werden.
Ich habe nach öffnen der jeweiligen Datei diese in der Variabel WKb referenziert.
Diese kannst Du nun für Deine Zwecke verwenden oder einfach innerhalb im WITH-Bereich.
Durch Ansprache über die Referenzierung muss die Datei/Mappe auch nicht mehr unbedingt die aktive Mappe sein.
Sub AnzahlDateiAusOrdnerEinlesen()
Dim sDatei As String, sDateien(25, 1) As String, sPfad As String
Dim Anzahl As Integer, Zeit As Variant, i As Integer, j As Integer
Dim WKb As Workbook
Anzahl = Sheets("Tabelle1").Range$("$G$6").Value 'ggf. anpassen
If Anzahl = 0 Then Anzahl = 7
sPad = "P:\Praxissemester\GFos-Daten E-Mail-Verteiler\" 'ggf anpassen
sDatei = Dir$(sPfad & "*.xls*") 'Nur Excel-Dateien ggf. anpassen
'Alle Dateien entsprechend der Dir-Maske im Pfad durchgehen
Do While sDatei <> ""
If sDatei <> ThisWorkbook.Name Then
Zeit = FileDateTime(sPfad & sDatei)
Zeit = Mid$(Zeit, 7, 4) & Mid$(Zeit, 4, 2) & Left$(Zeit, 2) _
& Mid$(Zeit, 12, 2) & Mid$(Zeit, 15, 2) & Right$(Zeit, 2)
For i = 1 To Anzahl + 1
'Prüfen ob Datei neuer als bisherige Dateien
If (Zeit <= sDateien(i, 1) And sDateien(i, 1) <> "") Or i = Anzahl Then
'Platz schaffen durch Verschieben der Einträge im Array
For j = 1 To i
sDateien(j - 1, 0) = sDateien(j, 0)
sDateien(j - 1, 1) = sDateien(j, 1)
Next j
'Datei und Zeit ins Array einfügen
sDateien(i - 1, 0) = sPfad & sDatei
sDateien(i - 1, 1) = Zeit
Exit For
End If
Next i
End If
sDatei = Dir
Loop
'öffnen der gefundenen Dateien, beginnend mit der neuesten Datei
For i = Anzahl - 1 To 0 Step -1
If sDateien(i, 0) <> "" Then
Workbooks.Open Filename:=sDateien(i, 0)
Set WKb = ActiveWorkbook 'Workbook referenzieren
With WKb
'Mach was mit mir.....
'MSGBOX .Sheets(1).Range("$A$1").value
'MSGBOX Wkb.Sheets(1).Range("$A$1").value
.Close SaveChanges:=False 'Schließen, ohne zu speichern
End With
End If
Next
End Sub
Hoffe, jetzt ist es etwas klarer geworden, ansonsten melde Dich einfach noch mal hier.
Viele Grüße
Karl-Heinz