Kommaproblem CSV-Datei
23.07.2020 13:19:11
Sonnenfreund
ich habe im Netz einen Code gefunden, der es ermöglicht, automatisch das erste Blatt aus einer CSV-Datei aus einem Verzeichnis in ein neues Excel-Blatt zu überführen.
Soweit funktioniert das auch.
Mein Problem ist, dass sobald in der CSV-Datei in einer Zelle ein Komma auftaucht, werden die weiteren Zellen in der Zeile nicht mehr kopiert. Die darauffolgenden Zeilen werden, sofern kein Komma in einer Zelle auftaucht, vollständig kopiert.
Die CSV-Dateien werden automatisch durch ein Programm erzeugt und auf das Verwenden der Kommata habe ich keinen Einfluss...
Kann mir jemand sagen, was ich an dem folgenden Code ändern muss, damit die Zeile trotz Komma vollständig kopiert wird?
Option Explicit
' ********************************************************************************************** _
' Autor/en: http://www.online-vba.de
- Marc Wershoven
' Verwendung der Quelltexte auf eigene Gefahr!
' Es gelten die Nutzungsbedingungen von www.online-vba.de!
' Original-Quelltext: www.online-vba.de/vba_datensammeln3.php
' ********************************************************************************************** _
'Hinweise: Die Zieldatei darf nicht im gleichen Verzeichnis sein, wie die einzulesenden Dateien. _
'Das Beispielmakro importiert immer das erste Arbeitsblatt von allen Dateien, die im
'angegebenen Verzeichnis enthalten sind. Diese Arbeitsblätter werden in die Arbeitsmappe eingefü _
gt,
'in der sich das folgende Makro befindet und gestartet wird.
'Die einzulesenden Dateien müssen geschlossen sein.
Sub MWSheetsAusMehrerenDateienEinlesen()
Dim oTargetBook As Object
Dim oSourceBook As Object
Dim sPfad As String
Dim sDatei As String
Application.ScreenUpdating = False 'Das "Flackern" ausstellen
Application.DisplayAlerts = False 'Keine Fehlermeldungen anzeigen
'Schritt 1: Arbeitsmappe festlegen, in die die neuen Sheets eingefügt werden...
Set oTargetBook = ActiveWorkbook
'Wichtiger Hinweis: Die Arbeitsblätter dürfen nicht vorhanden sein!
'Alternativer Umbau: Löschen evtl. bereits vorhandener Arbeitsblätter
'Schritt 2: Schleife über alle Excel Dateien in einem Verzeichnis
sPfad = "Pfad" _
'ich habe hier nur exemplarisch den Pfad angegeben
sDatei = Dir(CStr(sPfad & "*.csv")) 'Alle Excel Dateien
Do While sDatei ""
'Schritt 3: öffnen der Datei und Datenübertragung
Set oSourceBook = Workbooks.Open(sPfad & sDatei, False, 5) 'nur lesend öffnen
'Es wird immer das erste Tabellenblatt Sheets(1) kopiert!
oSourceBook.Sheets(1).Copy after:=oTargetBook.Sheets(oTargetBook.Sheets.Count)
'Es wird versucht den Dateinamen als Arbeitsblattnamen zu setzen.
'Ist dieser bereits vorhanden wird der Fehler abgefangen und das neue Blatt
'bekommt keinen anderen Namen und behält den typischen Namen Tabelle x
On Error Resume Next
'Arbeitsblattname wird der Dateiname
oTargetBook.Sheets(oTargetBook.Sheets.Count).Name = sDatei
'Wenn ein Fehler aufgetreten ist, wird dieser resettet
If Err.Number 0 Then
Err.Number = 0
Err.Clear
End If
On Error GoTo 0
'Schritt 4: Datei wieder zu machen und nächste Schleifenrunde
oSourceBook.Close False 'nicht speichern
'Nächste Datei
sDatei = Dir()
Loop
Application.ScreenUpdating = True 'Das Bildschirm-Aktualisieren wieder einschalten
Application.DisplayAlerts = True 'Fehlermeldungen wieder anzeigen
'Kleine finale Fertig-Meldung
MsgBox "Fertig!", vbInformation + vbOKOnly, "Hinweis!"
'Variablen aufräumen
Set oTargetBook = Nothing
Set oSourceBook = Nothing
End Sub