CSV import UTF-8
26.01.2021 15:40:21
Felix
das letzte Jahr bin ich gut alleine zurecht gekommen, allerdings komme ich heute leider wirklich nicht weiter.
Es geht darum, dass ich ein CSV datei importieren muss und mir im Normalfall die Umlauet zerschossen werden.
Folgende Lösung habe ich gefunden und angepasst. Aber ich glaube ich habe ein Problem mit dem Zeilenumbruch.
Excel hört leider nach der ersten zeile auf. Ich habe auch absolut keine Idee mehr woran es liegen könnte:
Sub DatenBesorgen()
'Daten aus der CSV in die Excel kopieren
Dim DateiName As String
Dim ReplacePrep As String
Dim LineFromFile As String
Dim LineItems As Variant
Dim row_number As Long
Dim objStream As Object
DateiName = "C:\Users\f_froelich\Desktop\Samsara Berichte\(Samsara)_Fahrtverlaufsbericht_- _
_
_
_
_Rudolph_Logistik__Jan_19_2021_-_Jan_26_2021.csv"
Set objStream = CreateObject("ADODB.Stream")
objStream.Charset = "utf-8"
objStream.Open
objStream.LoadFromFile (DateiName)
row_number = 1
Do Until objStream.EOS 'Gesammtes TextDok durchgehen
LineFromFile = objStream.ReadText(-2) 'Zeile aus Quelldatei einlesen
LineItems = Split(LineFromFile, ",")
Worksheets("Tabelle1").Cells(row_number, 1).Value = LineItems(0)
Worksheets("Tabelle1").Cells(row_number, 2).Value = LineItems(1)
Worksheets("Tabelle1").Cells(row_number, 3).Value = LineItems(2)
Worksheets("Tabelle1").Cells(row_number, 4).Value = LineItems(3)
Worksheets("Tabelle1").Cells(row_number, 5).Value = LineItems(4)
Worksheets("Tabelle1").Cells(row_number, 6).Value = LineItems(5)
Worksheets("Tabelle1").Cells(row_number, 7).Value = LineItems(6)
Worksheets("Tabelle1").Cells(row_number, 8).Value = LineItems(7)
row_number = row_number + 1
Loop
Set objStream = Nothing
End Sub
Anbei auch die ersten drei Zeilen aus meiner CSV-Datei:
Fahrzeug,Fahrer,Fahrtbeginn,Beginnen bei,Fahrtende,Beenden bei,Fahrtdaüer,Dauer der Pause,Kilometer
KS-R 7154,Unassigned,"K 30, Salzgitter, NDS, 38239",Jan 19 11:21AM CET,"Beispiel, T, 07907",Jan 19 2:40PM CET,3h 18m,33m 12s,280.8
KS-R 7320,Unassigned,Hankook Tire Netherlands B.V.,Jan 19 12:56PM CET,Koller Kunststofftechnik GmbH,Jan 19 2:03PM CET,1h 7m,1h 32m,65.7
Vielen Dank vorab für eure Hilfe
Grüße Felix
Anzeige