Das Schreiben an die jeweilige Stelle überlass ich dir.
Option Explicit
Private Type TUDFileInfo
Idx1 As Integer
Idx2 As Integer
Date As Date
Name As String
Path As String
Extension As String
End Type
Public Sub Test()
Const C_FOLDER As String = "X:\Verzeichnis\Unterverzeichnis"
Const C_FILEINFO_ARRAY_INCR As Long = 6
Dim audfi() As TUDFileInfo
Dim strFile As String
Dim i As Long
ReDim audfi(1 To C_FILEINFO_ARRAY_INCR)
i = LBound(audfi)
'alle relevanten CSV-Dateien im Verzeichnis ermitteln
strFile = Dir$(C_FOLDER & "\*.csv")
Do Until strFile = ""
If GetUDFileInfo(C_FOLDER & "\" & strFile, audfi(i)) Then
i = i + 1
If i > UBound(audfi) Then
ReDim Preserve audfi(1 To UBound(audfi) + C_FILEINFO_ARRAY_INCR)
End If
End If
strFile = Dir$()
Loop
If i = LBound(audfi) Then
Call MsgBox("Keine CSV-Dateien in '" & C_FOLDER & "' gefunden", vbExclamation)
Else
ReDim Preserve audfi(1 To i - 1)
i = LBound(audfi)
If Sort(audfi) Then
'> ab hier <
'> liegt 'audif' <
'> sortiert vor <
For i = LBound(audfi) To UBound(audfi)
With audfi(i)
'Ausgabe im VBA-Direktfenster (ggf. einblenden mit STRG+G)
Debug.Print .Idx1, .Idx2, Format$(.Date, "yy-mm-dd")
End With
Next
Call MsgBox("Fertig.", vbInformation)
Else
Call MsgBox("Sortieren ist fehlgeschlagen", vbCritical)
End If
End If
Erase audfi
End Sub
Private Function Sort(UDFileInfo() As TUDFileInfo) As Boolean
Dim wks As Excel.Worksheet
Dim rngRow As Excel.Range
Dim blnSU As Boolean
Dim blnDA As Boolean
Dim i As Long
blnSU = Application.ScreenUpdating
Application.ScreenUpdating = False
blnDA = Application.DisplayAlerts
Application.DisplayAlerts = False
On Error GoTo ErrHandler
'Wir werden hier faulerweise Excel sortieren lassen.
'Dazu benötigen wir ein temporäres Tabellenblatt.
Set wks = Worksheets.Add
'Die zu sortierte Daten ins Tabellenblatt schreiben
For i = LBound(UDFileInfo) To UBound(UDFileInfo)
Set rngRow = wks.Range("A" & i & ":F" & i)
With UDFileInfo(i)
rngRow.Value = Array(.Idx1, .Idx2, Format$(.Date, "'yyyy-mm-dd"), .Path, .Name, .Extension)
End With
Next
With wks.Range("A" & LBound(UDFileInfo) & ":F" & UBound(UDFileInfo))
'Nach Idx1, Idx2 und anschließend nach Date sortieren (alle aufsteigend)
Call .Sort(Key1:=.Cells(1, 1), _
Key2:=.Cells(1, 2), _
Key3:=.Cells(1, 3), _
Header:=xlNo)
'sortierte Daten nun zurückschreiben
For i = 1 To .Rows.Count
Set rngRow = .Range("A" & i & ":F" & i)
With UDFileInfo(i)
.Idx1 = rngRow.Cells(1).Value
.Idx2 = rngRow.Cells(2).Value
.Date = CDate(rngRow.Cells(3).Value)
.Path = rngRow.Cells(4).Value
.Name = rngRow.Cells(5).Value
.Extension = rngRow.Cells(6).Value
End With
Next
End With
Sort = True
SafeExit:
If Not wks Is Nothing Then
Call wks.Delete 'temporäre Tabellenblatt löschen
Set wks = Nothing
End If
Application.DisplayAlerts = blnDA
Application.ScreenUpdating = blnSU
Exit Function
ErrHandler:
'...
' Sort = False
GoTo SafeExit
End Function
Private Function GetUDFileInfo(Filename As String, ByRef UDFileInfo As TUDFileInfo) As Boolean
With UDFileInfo
'ggf. Dateiname und Dateipfad voneinander trennen
If InStrRev(Filename, "\") > 0 Then
.Path = Trim$(Left$(Filename, InStrRev(Filename, "\")))
.Name = Mid$(Filename, Len(.Path) + 1, Len(Filename) - Len(.Path))
Else
.Path = ""
.Name = Trim$(Filename)
End If
'ggf. (am weitesten rechts stehende) Dateiendung entfernen
If InStrRev(.Name, ".") > 0 Then
.Extension = Right$(.Name, Len(.Name) - InStrRev(.Name, "."))
.Name = Left$(.Name, Len(.Name) - Len(.Extension) - 1)
End If
'prüfen ob der Dateiname den erwartenden Kriterien entspricht
If Not .Name Like "Z##_Z##_D######" Then Exit Function
'Informationen sammeln
.Idx1 = Mid(.Name, 2, 2)
.Idx2 = Mid(.Name, 6, 2)
' .Date = DateSerial(Year:=Mid(.Name, Len(.Name) - 5, 2), _
' Month:=Mid(.Name, Len(.Name) - 3, 2), _
' Day:=Right(.Name, 2))
.Date = CDate(Format$(Right$(.Name, 6), "\2\000-00-00"))
End With
GetUDFileInfo = True
End Function
|