Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1496to1500
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Fehler bei CSV Import

Fehler bei CSV Import
02.06.2016 19:05:34
Anton
Hallo Zusammen,
im Forum habe ich das unten stehende Makro gefunden, welches die Inhalte aller CSV Dateien im Zielordner in neue Tabellenblätter schreibt.
Leider funktioniert die Spaltenaufteilung mit der Split Funktion trotz "," als Trennzeichen nicht. Es funktioniert nur wenn ich die Dateien vorher öffne und nochmal als .csv speichere.
Gibt es hierfür evtl. einen simplen Trick? Nach meiner Recherche funktioniert die Vorgehensweise super, nur in meinem Fall nicht.
Hier das Makro:
Public intCalculation As Integer
Sub CSV2XLS()
'Alle .csv (Trennzeichen ;) eines Ordners in .xls umwandeln
Dim oFS As Object, oFolder As Object, oFile As Object
Dim tmpName As String
Dim tarName As String
Dim strFolder As String
Dim strTxt As String, myArr, lngL As Long, wks As Worksheet, iFree As Integer
With Application.FileDialog(4)
.AllowMultiSelect = True
.InitialFileName = "c:\"
.InitialView = 2
.Title = "Bitte einen Ordner wählen"
If .Show = -1 Then
strFolder = .SelectedItems(1)
Else
Exit Sub
End If
End With
On Error GoTo FEHLER
DoEvents
GetMoreSpeed
Set oFS = CreateObject("scripting.filesystemobject")
Set oFolder = oFS.GetFolder(strFolder)
iFree = FreeFile
For Each oFile In oFolder.Files
If oFile.Name Like "*.csv" Then
tmpName = oFile.Name
tarName = Right(tmpName, 21)
oFile.Name = tarName
Set wks = Worksheets.Add
wks.Name = oFile.Name
lngL = 1
Open oFile For Input As iFree
Do Until EOF(iFree)
Line Input #iFree, strTxt
myArr = Split(strTxt, ",")
With wks
.Range(.Cells(lngL, 1), .Cells(lngL, UBound(myArr) + 1)) = myArr
End With
lngL = lngL + 1
Loop
Close #iFree
End If
Next oFile
AUFRAEUMEN:
Set oFile = Nothing
Set oFolder = Nothing
Set oFS = Nothing
GetMoreSpeed False
Exit Sub
FEHLER:
If Err.Number Then
MsgBox "Fehler!" & vbLf & Err.Description
Err.Clear
Resume AUFRAEUMEN
End If
End Sub

Sub GetMoreSpeed(Optional ByVal Modus As Boolean = True)
If Modus = True Then intCalculation = Application.Calculation
With Application
.ScreenUpdating = Not Modus
.EnableEvents = Not Modus
.Calculation = IIf(Modus = True, xlManual, intCalculation)
.Cursor = IIf(Modus = True, 2, -4143)
End With
End Sub
Danke schon mal für Eure Unterstützung.
Viele Grüße, Anton

8
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Fehler bei CSV Import
02.06.2016 19:51:22
Fennek
Hallo Anton,
an der Fehlerbeschreibung kann man nur arbeiten, wenn man das Script im Einzelschritt-Modus (F8) ausführt und sich alle relevanten Zwischenergebnisse mit Debug.print ansieht. Falls du Probleme damit hast, lade ein Beispiel-csv-Datei hoch.
mfg

AW: Fehler bei CSV Import
02.06.2016 23:43:22
Anton
Hallo Fennek,
danke für Deine schnelle Rückmeldung. Ich habe mich noch mal intensiv damit befasst aber komme nicht drauf. Hier die File: https://www.herber.de/bbs/user/105948.txt
Für den Upload habe ich .csv in .txt umbenannt.
Danke & VG,
Anton

Anzeige
AW: Fehler bei CSV Import
03.06.2016 00:02:19
snb
Versuch mal
Sub M_snb()
sheets.add ,,,"G:\OF\105948.csv"
End Sub

AW: Fehler bei CSV Import
03.06.2016 08:53:39
Fennek
Hallo Anton,
ich versuche es etwas ausführlicher zu erklären:
Es gibt m.W. nach 3 Wege, eine csv-Datei einzulesen:
1. snb's Methode mit "sheets.add: einfach und genial (habe ich erst vor kurzem kennengelernt
2. Die übliche mit workbooks.open (siehe unten)
3. mit open sFile for reading, alte Methode aus den Anfängen von vba
Alle 3 Ansätze (können) funktionieren
In meinem Test sah es so aus, dass die Txt-Datei vom Mac kommt, also der Zeichen-Code beachtet werden müßte.
Den folgenden Code habe ich mit dem Rekorder aufgezeichenet und, bis auf ein merkwürdiges Zeichen, scheint es zu klappen.

Workbooks.OpenText Filename:= _
"Z:\Anton_Her.txt", Origin:= _
xlMacintosh, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _
Comma:=True, Space:=False, Other:=False, FieldInfo:=Array(1, 1), _
TrailingMinusNumbers:=True
Der Dateinamen muss durch die Schleifenvariable ersetzt werden.
mfg

Anzeige
AW: Fehler bei CSV Import
05.06.2016 20:24:17
Michael
Hi zusammen,
@Fennek: der 4. Weg ist im Prinzip, den Text als String zeilenweise oder in einem "Riesenstring" am Stück einzulesen (zur Info auskommentiert im Code skizziert).
@alle:
Allerdings hatte ich bei DIESER csv dann irgendwann keine Lust mehr, da sie "byteweise programmiert" so was von widerspenstig ist: ein split nach "," geht natürlich nicht, wenn "," teilweise in Zahlenwerten vorkommt, und leider ist die csv *nicht* (wie im Prozedurkopf erwähnt) mit ";", sondern eben mit "," getrennt).
Auch nach erfolgreichem Import mit Deinem Codeschnipsel gibt es noch Einiges nachzubearbeiten, nämlich diese elenden chr(160) vor dem % bzw. € rauswerfen usw.
Hier alles am Stück:
Option Explicit
Public intCalculation As Integer
Sub SpaltenBearbeiten()
Dim wie() As Variant
Dim i&, r As Range, zMax&, j&, k&, erste&
Dim a As Variant
Application.Calculation = xlCalculationAutomatic
ReDim wie(1 To 3, 1 To 5)
wie(1, 1) = "B": wie(1, 2) = ".": wie(1, 3) = "": wie(1, 4) = 2: wie(1, 5) = 1
wie(2, 1) = "F": wie(2, 2) = Chr(160) & "%": wie(2, 3) = "": wie(2, 4) = 2: wie(2, 5) = 0.01
wie(3, 1) = "H": wie(3, 2) = Chr(160) & "€": wie(3, 3) = "": wie(3, 4) = 1: wie(3, 5) = 1
For i = 2 To 3   'Spalten B/C sind bereits "automatisch" Zahlen
zMax = Range(wie(i, 1) & Rows.Count).End(xlUp).Row
Range(wie(i, 1) & 1).Resize(zMax, wie(i, 4)).Replace wie(i, 2), wie(i, 3)
'  führt leider zu unschönen Nullen ...
'  Range("xy1") = wie(i, 5): Range("xy1").Copy
'  Range(wie(i, 1) & 1).Resize(zMax, wie(i, 4)).PasteSpecial _
'  Paste:=xlPasteAll, Operation:=xlMultiply
'  Range("xy1") = Empty
Set r = Range(wie(i, 1) & 1).Resize(zMax, wie(i, 4))
a = r
For j = 1 To UBound(a)
For k = 1 To wie(i, 4)
If Len(a(j, k)) Then
If IsNumeric(a(j, k)) Then
a(j, k) = a(j, k) * wie(i, 5)
If erste = 0 Then erste = j
End If
End If
Next
Next
' geht komischerweise nicht, wegen des resize mit array-Wert?!
' Range(wie(i, 1) & 1).Resize(zMax, wie(i, 4)) = a
' Range(wie(i, 1) & 1 & ":" & wie(i, 1) & zMax).Resize(, wie(i, 4)) = a
' dann eben mit gesetzter range-Variable r
r = a
If Right(wie(i, 2), 1) = "%" Then r.Offset(erste - 1).NumberFormat = "0.00 %"
If Right(wie(i, 2), 1) = "€" Then r.Offset(erste - 1).NumberFormat = _
"_-* #,##0.00 [$€-407]_-;-* #,##0.00 [$€-407]_-;_-* ""-""? [$€-407]_-;_-@_-"
Next
'und zu guter Letzt noch das Datum als echtes Excel-Datum:
zMax = Range("A" & Rows.Count).End(xlUp).Row
Range("A" & zMax).Value = DateValue(Range("A" & zMax).Text)
End Sub
Sub CSV2XLS()
'Alle .csv (Trennzeichen ;) eines Ordners in .xls umwandeln
Dim oFS As Object, oFolder As Object, oFile As Object
Dim tmpName As String
Dim tarName As String
Dim strFolder As String
Dim strTxt As String, myArr, lngL As Long, wks As Worksheet, iFree As Integer
With Application.FileDialog(4)
.AllowMultiSelect = True
.InitialFileName = "c:\"
.InitialView = 2
.Title = "Bitte einen Ordner wählen"
If .Show = -1 Then
strFolder = .SelectedItems(1)
Else
Exit Sub
End If
End With
'  On Error GoTo FEHLER
DoEvents
'  GetMoreSpeed
Set oFS = CreateObject("scripting.filesystemobject")
Set oFolder = oFS.GetFolder(strFolder)
'  'Das gehört sich IN die Schleife...
'  iFree = FreeFile
For Each oFile In oFolder.Files
If oFile.Name Like "*.csv" Then
'        tmpName = oFile.Name
'        tarName = Right(tmpName, 21)
'        ' Die nächste Anweisung geht so nicht
'        ' (weil der Name bei mir kleiner ist als 21 Zeichen)
'        ' Aber:
'        ' Während man eine Verzeichnisstruktur durchläuft,
'        ' sollte man besser nichts an den Namen ändern:
'        ' DAS würde ich in einem getrennten Lauf machen.
'        oFile.Name = tarName
Set wks = Worksheets.Add
wks.Name = oFile.Name
'      lngL = 1
'      ' Dieser Code ist bei DIESER Dateistruktur nicht sinnvoll anwendbar,
'      ' da die Datei keine passenden "Zeilentrenner" (CrLf=chr(13)&chr(10)) enthält.
'      Open oFile For Input As iFree
'      Do Until EOF(iFree)
'        Line Input #iFree, strTxt
'        myArr = Split(strTxt, ",")
'        With wks
'          .Range(.Cells(lngL, 1), .Cells(lngL, UBound(myArr) + 1)) = myArr
'        End With
'        lngL = lngL + 1
'      Loop
'      Close #iFree
'      ' Die Alternative wäre eine zusätzliche Stringvariable s und das Einlesen
'      ' in einem Rutsch:
'      s = String(FileLen(Datei), 0)
'      iFree = FreeFile
'      Open oFile For Binary Access Read As #1
'      Get iFree, , s
'      Close #iFree
'      ZeilenArr = Split(s, vbLf) ' eben nicht vbCrLf
'      'usw.
'  Hier analog zu Fenneks aufgezeichnetem Code unter W7/XL2013
Workbooks.OpenText Filename:=strFolder & "\" & oFile.Name, Origin:=65001, _
StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False, Comma:=True _
, Space:=False, Other:=False, FieldInfo:=Array(1, 1), _
TrailingMinusNumbers:=True
ActiveSheet.UsedRange.Copy wks.Range("A1")
ActiveWorkbook.Close savechanges:=False
SpaltenBearbeiten
End If
Next oFile
AUFRAEUMEN:
Set oFile = Nothing
Set oFolder = Nothing
Set oFS = Nothing
GetMoreSpeed False
Exit Sub
FEHLER:
If Err.Number Then
MsgBox "Fehler!" & vbLf & Err.Description
Err.Clear
Resume AUFRAEUMEN
End If
End Sub
Sub GetMoreSpeed(Optional ByVal Modus As Boolean = True)
If Modus = True Then intCalculation = Application.Calculation
With Application
.ScreenUpdating = Not Modus
.EnableEvents = Not Modus
.Calculation = IIf(Modus = True, xlManual, intCalculation)
.Cursor = IIf(Modus = True, 2, -4143)
End With
End Sub

(Das getmorspeed und on error habe ich zum Entwickeln auskommentiert)
Als ganze Datei mit noch ein paar Hinweisen: https://www.herber.de/bbs/user/106004.xlsm
@Fennek: ich habe Deinen kürzlichen Hinweis von wegen Gefahren beim Download von "xlsm" im Hinterkopf...
Sag, sollte es nicht reichen, "immer" eine "Herber"-Datei geöffnet zu haben, von der aus man die runtergeladene Datei öffnet, und zwar mit appl.enableevents=false, readonly=true usw., dann werden evtl. event-gesteuerte Makros nicht ausgeführt, und man kann in aller Ruhe erst mal den Code überfliegen.
Ein netter Nebeneffekt wäre, daß man interessante Dateien dann gleich in einer Liste fortschreiben und evlt. mit Kommentaren, Forumslink oder Stichwörtern versehen könnte.
Happy Exceling,
Michael

Anzeige
CSV Nachtrag
05.06.2016 20:32:26
Michael
nochmal...
a) in meinem Illustrations-Code steht

Open oFile For Binary Access Read As #1
, die 1 muß natürlich durch ifree ersetzt werden
b) ALLE Dateien zu durchlaufen und dann nach "*.csv" zu überprüfen finde ich etwas unglücklich: da täte es auch eine Konstruktion mit Dir(...) - Geschmackssache.
c) Die importierten Werte sollen sicher im Nachhinein noch ausgewertet werden. Dann wäre es günstiger, alles in EINEM Blatt zu speichern, z.B. mit lfd. Nummern in Spalte A, Herkunft=Dateiname in Spalte B und einem zu erzeugenden Typ-Kennzeichen in Spalte C (z.B. 3 wenn # oder Text, 2 wenn Datum und 1 wenn Werte), den Import dann rechts daneben ab Spalte D: dann kann man alle importierten Werde rauf und runtersortieren, filtern usw., ohne sie erst wieder zusammenpfriemeln zu müssen.
Ciao,
Michael

Anzeige
AW: CSV Nachtrag
06.06.2016 10:53:25
Anton
Hi Michael,
vielen vielen Dank für Deinen Nachtrag. Ich bin immer wieder baff, wie viele engagierte Leute sich hier tummeln. Ich werde mich heute Abend gleich mal hinsetzen und versuchen Deine Vorschläge umzusetzen. Und ja, ich habe mir an dieser CSV auch schon die Zähne ausgebissen.
VG Anton

AW: CSV Nachtrag
06.06.2016 19:06:22
Michael
Hi Anton,
ich sehe grad, daß ich da einen Hund drin hatte: wenn ich oben getmorespeed auskommentiere, muß es unten nach dem AUFRAEUMEN: natürlich auch raus.
Und meine "Werde" ärgern mich auch: ist halt richtig fränkisch, gell, wie bei Walllbolllidschellla.
Ok, viel Spaß beim Basteln, und melde Dich halt nochmal,
Gruß,
Michael
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige