|  
                                             
	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
	  
     |