Dateien in richtiger Reihenfolge abarbeiten

Hallo zusammen,
ich habe mir mit script gebaut, mit dem ich mehrere .txt Dateien in einem Ordner bearbeite und danach in Unterordner sortiere.
Dazu verwende ich folgenden Code, den ich selbst über google gefunden habe:
Set FS=CreateObject("Scripting.FileSystemObject")
Set Folder=FS.GetFolder("c:\temp")
For Each File in Folder.Files
If File.Name Like "*.txt" Then
'Hier wird die Datei berabeitet und verschoben'
End If
Next
Funktioniert soweit sehr gut, das Problem ist allerdings, dass ich eine andere Abarbeitungsreihenfolge der Dateien brauche. Das Script soll die Dateien sortiert nach Änderungsdatum abarbeiten (älteste zuerst).
Kann mir jemand sagen, wie ich den Code ändern muss, um gewünschtes Verhalten zu realisieren?
Grüße

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hi
hier, teste mal:

Sub sbModiDate()
'alle verwendeten Variablen sollten - immer - deklariert werden
Dim FS As Object, Folder As Object, File As Object
Dim larstrFileAttr() As String, liIdx As Integer
'der Einsatz von Scripting.Host wird aktiviert
Set FS = CreateObject("Scripting.FileSystemObject")
Set Folder = FS.GetFolder("c:\temp")
'die mehrdimensionale Arrayvariable larstrFileAttr wird dimensioniert
'(für jeden Datensatz werden 2 Spalten benötigt: vollständiger Dateiname + Änderungsdatum  _
der Datei)
ReDim larstrFileAttr(1, 0)
'alle Dateien im vorgegebenen Verzeichnis, C:\Temp, werden überprüft
For Each File In Folder.Files
'wenn es eine txt-Datei ist, dann...
If File.Name Like "*.txt" Then
'...wird der vollständige Dateipfad (Pfad + Name) in der Arrayvariablen  _
gespeichert
larstrFileAttr(0, UBound(larstrFileAttr, 2)) = File.Path
'...wird das Änderungsdatum in der Arrayvariablen gespeichert
larstrFileAttr(1, UBound(larstrFileAttr, 2)) = File.datelastmodified
'...erhält die Arrayvariable eine Zeile mehr, damit Platz ist für die nächste  _
txt-Datei
ReDim Preserve larstrFileAttr(1, UBound(larstrFileAttr, 2) + 1)
End If
Next
'die letzte Zeile der Arrayvariablen ist immer leer
'deswegen wird die letzte Zeile wieder entfernt
ReDim Preserve larstrFileAttr(1, UBound(larstrFileAttr, 2) - 1)
'es wird eine Hilfstabelle der Datei hinzugefügt
Sheets.Add after:=Sheets(Sheets.Count)
'alle zuvor gefundenen txt-Dateien werden in die Hilfstabelle in die Spalten A (vollstä _
ndiger Pfad) und B (Änderungsdaten) geschrieben
For liIdx = 0 To UBound(larstrFileAttr, 2)
Range("A" & liIdx + 1).Value = larstrFileAttr(0, liIdx)
Range("B" & liIdx + 1).Value = larstrFileAttr(1, liIdx)
Next
'alle benutzten Zeilen in Spalte A + B werden nach Spalte B (Änderungsdaten) sortiert ( _
der älteste Eintrag an erster Stelle)
With ActiveSheet.Sort
.SortFields.Clear
.SortFields.Add Key:=Range("B1:B" & Cells(Rows.Count, 2).End(xlUp).Row), SortOn:= _
xlSortOnValues, Order:=xlAscending, DataOption:=xlSortTextAsNumbers
.SetRange Range("A1:B" & Cells(Rows.Count, 2).End(xlUp).Row)
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'die Arrayvariable wird "resettet"
ReDim larstrFileAttr(1, 0)
'die jetzt nach Wunsch sortierten Einträge aus den Spalten A + B werden in die  _
Arrayvariable zurückgeschrieben
For liIdx = 1 To Cells(Rows.Count, 2).End(xlUp).Row
larstrFileAttr(0, liIdx - 1) = Range("A" & liIdx).Value
larstrFileAttr(1, liIdx - 1) = Range("B" & liIdx).Value
ReDim Preserve larstrFileAttr(1, UBound(larstrFileAttr, 2) + 1)
Next
'auch hier ist die letzte Zeile in der Arrayvariablen immer leer; sie wird entfernt
ReDim Preserve larstrFileAttr(1, UBound(larstrFileAttr, 2) - 1)
'die Hilfstabelle wird nicht mehr benötigt und deswegen kommentarlos gelöscht
Application.DisplayAlerts = False
ActiveSheet.Delete
Application.DisplayAlerts = True
For liIdx = 0 To UBound(larstrFileAttr, 2)
'HIER!!!! wird JETZT die Datei berabeitet und verschoben
'alle Dateien befinden sich nacheinander in ---> larstrFileAttr(0,liIdx)
'also:
larstrFileAttr(0,liIdx)=dein Code
Next
End Sub

Hilfts?
Ciao
Thorsten

Sub sbModiDate() Dim FS As Object, Folder As Object, File As Object Dim larstrFileAttr() As String, liIdx As Integer Dim lboArrOK As Boolean Set FS = CreateObject("Scripting.FileSystemObject") Set Folder = FS.GetFolder("c:\temp") ReDim larstrFileAttr(1, 0) For Each File In Folder.Files If File.Name Like "*.txt" Then larstrFileAttr(0, UBound(larstrFileAttr, 2)) = File.Path larstrFileAttr(1, UBound(larstrFileAttr, 2)) = File.datelastmodified ReDim Preserve larstrFileAttr(1, UBound(larstrFileAttr, 2) + 1) lboArrOK = True End If Next If lboArrOK = True Then ReDim Preserve larstrFileAttr(1, UBound(larstrFileAttr, 2) - 1) Else Set FS = Nothing Set Folder = Nothing Exit Sub End If Sheets.Add after:=Sheets(Sheets.Count) For liIdx = 0 To UBound(larstrFileAttr, 2) Range("A" & liIdx + 1).Value = larstrFileAttr(0, liIdx) Range("B" & liIdx + 1).Value = larstrFileAttr(1, liIdx) Next With ActiveSheet.Sort .SortFields.Clear .SortFields.Add Key:=Range("B1:B" & Cells(Rows.Count, 2).End(xlUp).Row), SortOn:= _ xlSortOnValues, Order:=xlAscending, DataOption:=xlSortTextAsNumbers .SetRange Range("A1:B" & Cells(Rows.Count, 2).End(xlUp).Row) .Header = xlGuess .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With ReDim larstrFileAttr(1, 0) For liIdx = 1 To Cells(Rows.Count, 2).End(xlUp).Row larstrFileAttr(0, liIdx - 1) = Range("A" & liIdx).Value larstrFileAttr(1, liIdx - 1) = Range("B" & liIdx).Value ReDim Preserve larstrFileAttr(1, UBound(larstrFileAttr, 2) + 1) Next ReDim Preserve larstrFileAttr(1, UBound(larstrFileAttr, 2) - 1) Application.DisplayAlerts = False ActiveSheet.Delete Application.DisplayAlerts = True For liIdx = 0 To UBound(larstrFileAttr, 2) 'HIER!!!! wird JETZT die Datei berabeitet und verschoben 'alle Dateien befinden sich nacheinander in ---> larstrFileAttr(0,liIdx) 'also: larstrFileAttr(0,liIdx)=dein Code Next Set FS = Nothing Set Folder = Nothing End Sub

Beliebteste Forumthreads (12 Monate)

Dateien in richtiger Reihenfolge abarbeiten

7 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread