Alle CSV-Dateien in einem Ordner mit einem VBA Makro einlesen - Datumsformat weg??

Hallo allerseits,
ich bin neu hier, versuche mich nur gelegentlich in vba-progrämmchen und war erfreut hier unter

"Alle CSV-Dateien in einem Ordner mit einem VBA Makro einlesen"

eine gelungene Programmsequenz (colinardo am 29.08.2013 um 11:49 Uhr)

für meine Zwecke gefunden zu haben.Leider übernimmt die Anwendung beim Einsammeln der csv-Daten
in einer Spalte nicht das Datumsformat.Für meine weitere Anwendung in excell 2010 benötige ich das
aber unnbedingt. Im csv-Ausgangsformat verfügen dieselben Daten noch über ein gültiges Datumsformat.

Wäre schön, wenn mir einer der hiesigen Könner helfen könnte. Habe schon alles Möglich probiert und
durchsucht. Komme nicht weiter. Vieln Dank schon mal für jeden brauchbaren Tipp!


Arbeite mit Win7/ Office 2010

Ach ja: habe das bei mir wie folgt abgeändert:

Sub ImportiereCSVDateien()


Const CSVPFAD = "F:\FiBu\Konto-Auszüge\Konto-Auszüge 2013\TAe"
Dim wbTarget As Workbook, wbSource As Workbook, ws As Worksheet, ts As Worksheet
Set fso = CreateObject("Scripting.Filesystemobject")
Set wbTarget = ActiveWorkbook
Application.DisplayAlerts = False

'Lösche alle Worksheets bevor wir alle neu anlegen
While wbTarget.Worksheets.Count > 1
wbTarget.Worksheets(1).Delete
Wend

wbTarget.Worksheets(1).Name = "Zusammenfassung"
wbTarget.Worksheets(1).Range("A:ZZ").Clear
For Each f In fso.GetFolder(CSVPFAD).Files
If LCase(Right(f.Name, 3)) = "csv" Then
Workbooks.OpenText Filename:=f.Path
Set wbSource = ActiveWorkbook
On Error Resume Next
Set ws = wbTarget.Worksheets(f.Name)
If Err <> 0 Then
Set ws = wbTarget.Worksheets.Add
ws.Name = f.Name
ws.Range("A:ZZ").Clear
End If

wbSource.Worksheets(1).Range("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Semicolon:=True, TrailingMinusNumbers:=True
wbSource.Worksheets(1).Range("A:ZZ").Copy Destination:=ws.Range("A1")
wbSource.Close False
End If
Next
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Konto_Nr_setzen


Range("B2").Select
ActiveCell.FormulaR1C1 = "=IF(R1C2=""Textschlüssel"",IF(RC1>0,2,0),0)"
Range("B2").Select
Selection.Copy
Range("B3:B500").Select
ActiveSheet.Paste
Sheets("1004147623.csv").Select
Range("B2").Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=IF(R1C2=""Textschlüssel"",IF(RC1>0,3,0),0)"
Range("B2").Select
Selection.Copy
Range("B3:B500").Select
ActiveSheet.Paste
Sheets("1010415147.csv").Select
Range("B2").Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=IF(R1C2=""Textschlüssel"",IF(RC1>0,1,0),0)"
Range("B2").Select
Selection.Copy
Range("B3:B500").Select
ActiveSheet.Paste

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''


Set ts = wbTarget.Worksheets("Zusammenfassung")
Dim curCell As Range
Set curCell = ts.Range("A1")
For i = 1 To wbTarget.Worksheets.Count - 1
maxRow = wbTarget.Worksheets(i).Range("A1").End(xlDown).Row
maxCol = wbTarget.Worksheets(i).Range("A1").End(xlToRight).Column
wbTarget.Worksheets(i).Range(wbTarget.Worksheets(i).Cells(1, 1), wbTarget.Worksheets(i).Cells(maxRow, maxCol)).Copy Destination:=curCell
Set curCell = curCell.End(xlDown).Offset(2, 0)
Next
Application.DisplayAlerts = True
Set fso = Nothing
Sheets("Zusammenfassung").Select


End Sub


VGe br-mv

Wenn die Daten durch Trennzeichen getrennt sind, ist dieses Argument ein Array aus Arrays mit zwei Elementen. Jedes Array mit zwei Elementen gibt die Umwandlungsoptionen für eine bestimmte Spalte an. Das erste Element ist die Spaltennummer (beginnend mit 1), und das zweite Element ist eine der xlColumnDataType-Konstanten, die angeben, wie die Spalte analysiert wird.

xlGeneralFormat. Allgemein 
xlTextFormat. Text  
xlMDYFormat. Datum im Format MTJ 
xlDMYFormat. Datum im Format TMJ 
xlYMDFormat. Datum im Format JMT 
xlMYDFormat. Datum im Format MJT 
xlDYMFormat. Datum im Format TJM 
xlYDMFormat. Datum im Format JTM 
xlEMDFormat. Datum im EMD-Format 
xlSkipColumn. Spalte überspringen 

feldFormate = Array(Array(1,xlTextFormat),Array(2,xlDMYFormat))
wbSource.Worksheets(1).Range("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Semicolon:=True, TrailingMinusNumbers:=True, FieldInfo:=feldFormate  

Set rngStart = ws.Range("G1")  
Set rngEnd = rngStart.End(xlDown)
For Each cell In ws.Range(rngStart, rngEnd)
   normalizedValue = Trim(Replace(cell.Value, "EUR", "", 1, -1, 1))  
   normalizedValue = Replace(normalizedValue, ",", ".", 1, -1, 1)  
   cell.NumberFormat = "#,##0.00 $"     
   cell.Value = normalizedValue
Next

Sub testImport()
    importCSV "C:\Temp\demo.csv", ";", ActiveSheet.Range("A1")  
End Sub

Function importCSV(strPath, delim, targetRange As Range)
    Set fso = CreateObject("Scripting.FileSystemObject")  
    Set regex = CreateObject("vbscript.regexp")  
    patNumber = "^([\d\.,\+\-]+)\s?(EUR|€|\$)$"  
    patDate = "^\d{2}\.\d{2}\.\d{2,4}$"  
    arrLines = Split(fso.OpenTextFile(strPath, 1).ReadAll(), vbNewLine, -1, vbTextCompare)
    Set rngCurrent = targetRange
    For i = 0 To UBound(arrLines)
        If arrLines(i) <> "" Then  
            cols = Split(arrLines(i), delim, -1, vbTextCompare)
            For c = 0 To UBound(cols)
                rngCurrent.Offset(0, c).ClearFormats
                wert = Trim(Replace(cols(c), """", "", 1, -1, vbTextCompare))  
                ' check for Numberformat  
                regex.Pattern = patNumber
                Set matches = regex.Execute(wert)
                If matches.Count > 0 Then
                    wert = Replace(matches(0).Submatches(0), ".", "", 1, -1, vbTextCompare)  
                    wert = Replace(wert, ",", ".", 1, -1, vbTextCompare)  
                    rngCurrent.Offset(0, c).NumberFormat = "#,##0.00 $;[RED]-#,##0.00 $"  
                End If
                'check for DateFormat  
                regex.Pattern = patDate
                Set matches = regex.Execute(wert)
                If matches.Count > 0 Then
                    wert = DateValue(matches(0))
                End If
                ' set value in cell  
                rngCurrent.Offset(0, c).Value = wert
            Next
            Set rngCurrent = rngCurrent.Offset(1, 0)
        End If
    Next
    ' Create ListObject table  
    targetRange.Worksheet.ListObjects.Add xlSrcRange, Range(targetRange, rngCurrent.Offset(0, targetRange.End(xlToRight).Column))
    
    Set fso = Nothing
    Set regex = Nothing
End Function