cvs Datei einlesen
Frank
ich kämpfe gerade mit dem Import von Daten aus einer csv bzw. mehreren csv Dateien. Es ist so das man sich die Datei aussuchen kann. Dann erfolgt der Import. Als nächstes kommt die Abfrage, ob eine weitere Datei eingelesen wird. Und nun werden die alten Daten einfach verschoben? Kann mir jemand anhand des Quelltextes sagen, an welcher 'Scharube' ich drehen muss, dass einfach das zweite Archiv unter das Erste angefügt wird? Dabei sollte ab der zweiten Datei die Überschrift aus der csv Datei nicht mehr eingelsen werden, da die bereits bei der Ersten eingelsen wird. Falls die Datei benötigt wird, hänge ich diese an. Hier nun der Quelltext.
Sub Öffnen()
Dim sCsvFile As String
Dim i As Integer, LetzteZeile As Integer
i = 0
LetzteZeile = 1
ChDir "\"
ChDrive "C:\"
marke_1:
Dateiname = Application.GetOpenFilename _
("CSV-Dateien (*.csv),*.csv,Textdateien (*.txt),* .txt,Alle Dateien (*.*),*.*") 'Das _
Dialogfenster
If Dateiname = False Then Exit Sub
sCsvFile = Dateiname
Application.ScreenUpdating = False
'MsgBox "Ihre Auswahl:" & vbNewLine & Dateiname
With Worksheets(1).QueryTables.Add(Connection:="TEXT;" & sCsvFile, Destination:=Worksheets(1). _
Cells(LetzteZeile, 1))
.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 = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(2, 2, 2, 1, 2, 2, 2, 2, 2, 2)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=True
End With
'Zeilen zählen
With Worksheets(1)
LetzteZeile = IIf(Len(.Cells(.Rows.Count, 9)), .Rows.Count, .Cells(.Rows.Count, 9).End(xlUp) _
.Row) 'auslesen der letzten Zeile, Spalte 9 deshalb, weil ein Pfad immer vorhanden ist und somit die letzte Zeile im Datenblatt erfasst wird
End With
'Abfrage, ob ein weiteres Archiv eingelsen werden soll
If MsgBox("Möchten Sie ein weiteres Archiv einlesen?", vbYesNo + vbQuestion, "Abfrage") = vbYes _
Then
GoTo marke_1
End If
'Sotieren der Spalten nach Pfad
'Zuweisung des Tabellenkopfes
Worksheets(1).Cells(1, 1) = "Interpret"
Worksheets(1).Cells(1, 2) = "Title"
Worksheets(1).Cells(1, 3) = "Album"
Worksheets(1).Cells(1, 4) = "Length"
Worksheets(1).Cells(1, 5) = "Jear"
Worksheets(1).Cells(1, 6) = "Genre"
Worksheets(1).Cells(1, 7) = "Evaluation"
Worksheets(1).Cells(1, 8) = "Bitrate"
Worksheets(1).Cells(1, 9) = "Path"
Worksheets(1).Cells(1, 10) = "Medium"
Worksheets(1).Cells(1, 11) = "Path_-1"
Worksheets(1).Cells(1, 12) = "Filename"
Worksheets(1).Cells(1, 13) = "double"
Worksheets(1).Cells(1, 14) = "Song No."
Worksheets(1).Cells(1, 15) = "copy_to_new_archive"
Worksheets(1).Cells(1, 16) = "Time [s]"
Worksheets(1).Cells(1, 17) = "Time [min]"
Worksheets(1).Cells(1, 18) = "Time_tot [min]"
Worksheets(1).Cells(1, 19) = "Interpret/ Multi-Interpret"
Worksheets(1).Cells(1, 20) = "new_Path"
Range(Cells(1, 1), Cells(1, 20)).Interior.ColorIndex = 15 'graue Hintergrundfarbe
Selection.Font.Bold = True 'Fett = True
Cells(1, 1).Select
Hauptmenü.Label2.Caption = "Es wurden " & LetzteZeile - 1 & " Songs erfolgreich importiert."
Application.ScreenUpdating = True
End Sub
Ich hoffe es kann mir jemand helfen.
Gruß,Frank.
Anzeige