Thema Datum  Von Nutzer Rating
Antwort
16.05.2014 16:59:32 Stefan
NotSolved
16.05.2014 18:29:45 Gast93640
NotSolved
16.05.2014 18:45:23 Gast13524
NotSolved
20.05.2014 10:42:04 Stefan
NotSolved
Rot CSV Dateien öffnen und je nach Dateinamen einfügen
20.05.2014 13:11:24 Gast68645
NotSolved

Ansicht des Beitrags:
Von:
Gast68645
Datum:
20.05.2014 13:11:24
Views:
1476
Rating: Antwort:
  Ja
Thema:
CSV Dateien öffnen und je nach Dateinamen einfügen

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

 


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
16.05.2014 16:59:32 Stefan
NotSolved
16.05.2014 18:29:45 Gast93640
NotSolved
16.05.2014 18:45:23 Gast13524
NotSolved
20.05.2014 10:42:04 Stefan
NotSolved
Rot CSV Dateien öffnen und je nach Dateinamen einfügen
20.05.2014 13:11:24 Gast68645
NotSolved