Hallo liebe VBA Freunde,

im folgenden Programm sollten CSV Dateien, die im gleichen Ordner liegen wie unsere Arbeitsmappe, importiert werden. Leider können wir unseren "Sortiermechanismus" nicht testen, da schon nach dem Block "Datei wird Importiert" kein einziger Zahlenwert in der Exceltabelle ankommt. Kann uns vielleicht jemand erklären wo sich der Fehler versteckt hat? :)

Noch ein Wort zum Sortiermechanismus:

Die Dateinamen haben die Form: "12-01-07_230001.csv". (entspricht Datei vom 7.1.2012)

Mit dem Schritt "Auslesen des Monats aus dem Dateinamen" wir der Wert "01" aus dem Namen geschnitten, der folgende Block macht gleiches mit "07" für den Tag.

Als Test sollte dann der Wert aus Zelle B2 der geöffneten Datei in unsere aktive Arbeitsmappe übertragen werden, und zwar in das Tabellenblatt "01" und die Zelle "A7".

Vielen Dank schon mal fürs "aus der Patsche helfen" :)

Sub Main()

' Ersten Eintrag abrufen____________________________________________________________________________________
DName = Dir(ThisWorkbook.Path)

' Schleife beginnen________________________________________________________________________________________
Do While DName <> ""
   
'Datei wird imortiert_______________________________________________________________________________________
    With ActiveSheet.QueryTables.Add(Connection:="TEXT;Pfad", Destination:=Range("$A$1"))
        .Name = DName
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 1252
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = True
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
        1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 _
        , 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With

'Testberechnung_________________________________________________________________________________________
Zelleninhalt = Cells(2, "B")

'Auslesen des Monats aus dem Dateinamen___________________________________________________________________
DateinameM = Left(ActiveWorkbook.Name, 100)
DateinameMKurz = Right(DateinameM, Len(DateinameM) - 3)
Monat = Left(DateinameMKurz, Len(DateinameMKurz) - 15)
'MsgBox (Monat)

'Auslesen des Tags aus dem Dateinamen___________________________________________________________________
DateinameT = Left(ActiveWorkbook.Name, 100)
DateinameTKurz = Right(DateinameT, Len(DateinameT) - 6)
Tag = Left(DateinameTKurz, Len(DateinameTKurz) - 11)
'MsgBox (Tag)

'Sortieren der Berechneten Werte in die jeweiligen Tabellenblätter 01-12____________________________________________
ActiveWorkbook.Worksheets(Monat).Cells(Tag, "A") = Zelleninhalt

' Nächsten Eintrag abrufen_________________________________________________________________________________
DName = Dir

Loop

End Sub