Office: (Office 2007) CSV-Datei mit Zeilenumbrüchen per VBA importieren

Hallo zusammen!

Ich sitze immernoch an einem Makro, welches eine CSV-Datei importieren (Daten -> Externe Daten importieren), bearbeiten und ganz zum Schluß wieder als CSV speichern soll. Das klappt mit einer Test-CSV auch schon alles sehr gut.

Ich habe nur ein Problem: Die Original-CSV's die später damit bearbeitet werden sollen, werden aus einer Datenbank exportiert und enthalten in einigen Feldern Zeilenumbrüche. Wenn ich die Datei in Excel importieren will ist sie (trotz korreckter Trennzeicheneinstellung) vollkommen zerschossen und wird völlig falsch dargestellt.

Gibt es da eine Möglichkeit, die Datei korreckt zu importieren? Denn wenn ich die Datei in Excel öffne (Datei öffnen -> Textdateien), wird sie korreckt dargestellt. Habe beim durchsuchen des Forums bisher nur was dazu gefunden, die Zeilenumbrüche zu löschen - ich will sie aber nicht löschen, sondern beibehalten und hinterher auch wieder mit exportieren!

Grüße

Mirko

:)

 

Moin, Mirko,

alles, was mir dazu einfällt, wäre die Umwandlung in ein nicht als Steuerzeichen oder sonstwie benötigtes Zeichen (z.B. als Leerzeichen CHR(160)), um den Zeilenumbruch umzuwandeln und nach dem Import wieder zu setzen.

 

Hi Jinx!

Ja, daran hab ich auch schon gedacht. Da muß ich mir nur noch ein Zeichen einfallen lassen, Leerzeichen wäre ja blöd - sollen ja nachher nicht alle vorhandenen Leerzeichen in Zeilenumbrüche umgewandelt werden.

Kann ich das eigentlich beim Import durch Excel machen lassen? Vermutlich muß ich das vor dem Import machen, richtig?

Grüße

Mirko

 

Moin, Mirko,

das normale Leerzeichen ist CHR(32), CHR(160) ist ein geschütztes Leerzeichen, was von Excel nicht als Leerzeichen erkannt wird - vermutlich kam mein Vorschlag aus dieser Überlegung heraus...

 

Hallo auch,

sind die Felder in denen Zeilenumbrüche vorkommen denn mit " umschlossen, d.h. so:

"1. Zeile 1. Spalte

immer noch die 1. Spalte

"; 2. Spalte; 3. Spalte; "4. Spalte mit ; drinne"; 1. Zeile 5. Spalte
2. Zeile 1 Spalte; 2. Spalte; 3. Spalte; ...

Dann hätte ich da vielleicht was ...

cu, Bernd

 

Hallo Bernd!

Yep, sind sie! Du hättest da vielleicht was? Na, das klingt ja vielversprechend *mrcool

 

Morgen Mirko,

versuch's mal hiermit. Noch ziemlich wenig getestet.

HTH, Bernd
--
Option Explicit

Const RecordSeperator As String = vbCrLf
Const FieldSeparator As String = ";"
Const TextQualifier As String = """"

Const TranslateCRLF As Boolean = True

Sub TestIt()
Call CSVRead("e:\test\test.csv")
End Sub

Public Sub CSVRead(fname As String)
Dim hfile As Integer ' Filehandle bzw. Dateinummer
Dim lngZeile As Long ' Zeilennummer in gelesenen Daten
Dim strAll As String ' die gesamte Datei als ein String
Dim arAll As Variant ' dito, in Records (Zeilen) aufgetrennt
Dim arRow As Variant ' eine Zeile in Felder (Spalten) aufgetrennt

hfile = FreeFile
Open fname For Binary As #hfile
strAll = Space(LOF(hfile))
Get #hfile, , strAll
Close #hfile

' CR LF in LF wandeln
If TranslateCRLF Then strAll = Replace(strAll, vbCrLf, vbLf)

' Zeilenweise splitten, hierbei die " noch stehen lassen
arAll = mySplitDoubled(strAll, IIf(TranslateCRLF, vbLf, RecordSeperator), False)

For lngZeile = 0 To UBound(arAll)
' Spaltenweise aufsplitten, hierbei die " entfernen
arRow = mySplitDoubled(CStr(arAll(lngZeile)), FieldSeparator, True)
' und in die Zellen als Text schreiben
With Range(Cells(lngZeile + 1, 1), Cells(lngZeile + 1, 1 + UBound(arRow)))
.NumberFormat = "@":
.Value = arRow
End With
Next
End Sub

'
' trennt einen Text in einzelne Felder
' berücksichtigt die Sonderfälle mit Textkennzeichner (Anführungszeichen)
'
Public Function mySplitDoubled(s As String, FS As String, DeleteTQ As Boolean) As Variant
Dim i As Integer ' Zähler über die einzelnen Zeichen
Dim FSlen As Integer ' die Länge von FS in Zeichen
Dim mydim As Integer ' die Dimension von arr()
Dim arr() As String ' das Rückgabe-Array
Dim ch As String ' das aktuelle Zeichen
Dim chNext As String ' das nächste Zeichen
Dim hilf As String ' der Feldwert wird hierin zusammengebaut
Dim Instring As Boolean ' Flag ob innerhalb von "..."

FSlen = Len(FS)
mydim = 0
Instring = False
Redim arr(mydim)
i = 1
For i = 1 To Len(s)
' Debug.Print i
ch = Mid(s, i, 1) ' das aktuelle Zeichen
If i < Len(s) Then
chNext = Mid(s, i + 1, 1) ' das nächste Zeichen
Else
chNext = Chr(0) ' Merker: es gibt kein nächstes Zeichen mehr
End If
If ch = TextQualifier Then ' Default: ein Anführungszeichen
If Not DeleteTQ Then hilf = hilf & TextQualifier
If Instring = False Then ' bisher noch kein " da gewesen
Instring = True ' jetzt haben wir eines
Else ' wir sind schon im "-String
If chNext = TextQualifier Then ' "" -> ein echtes "
hilf = hilf & TextQualifier
i = i + 1
Else
Instring = False ' "-String-Ende
End If
End If
ElseIf Mid(s, i, FSlen) = FS Then ' ein Feldtrenner (field seperator)
If Instring Then ' ist der innerhalb eines "..." ?
hilf = hilf & FS ' ja -> er ist ein normales Zeichen
Else
arr(mydim) = hilf ' NEIN, nächstes Feld
mydim = mydim + 1
Redim Preserve arr(mydim)
hilf = ""
End If
' i anpassen, es wurden u.U. mehr als ein Zeichen verbraucht
i = i + FSlen - 1
Else
hilf = hilf & ch ' Alles andere ist ein normales Zeichen
End If
Next
arr(mydim) = hilf ' das Letzte nicht vergessen
mySplitDoubled = arr
End Function

 

Hallo Bernd!

Na, da muß ich aber jetzt wirklich mal ein ganz dickes DANKESCHÖN sagen. Gebe zwar zu, daß ich es nicht wirklich im Einzelenen kapiere, was das Makro macht - aber es funktioniert bestens.

Habe allerdings ein Problem damit. In einigen Zeilen füllt Excel die Zelle mit ##### - war glaubich dafür, wenn der Zellinhalt zu groß ist um ihn darzustellen, oder? Wenn ich das ganze jetzt aber eben wieder in eine CSV exportiere speichert er in den Zellen die Rauten, statt dem eigentlichen Inhalt (welcher aus langen Pfadangaben + Timestamp besteht). Irgendeine Idee, wie man das verhindern kann?

Also, nochmal vielen Dank für Deine Hilfe!

Grüße

Mirko

 

Hi Mirko,

damit kenne ich mich nicht besonders aus :-(

Schau Dich vielleicht mal hier um: http://xlam.ch/xlimits/xllimit3.htm

Und, versuch's vielleicht mal so:

a) Verzichte auf die Zeile .NumberFormat = "@", das setzt die Zellformatierung auf Text, und ist wohl Schuld an den #.
Alternativ nimm hier .NumberFormat = "General", das ist Standard

b) Jetzt klemmt's irgendwann mit der Array-Zuweisung .Value = arRow
Dieses erzeugt bei zu langen Texten einen Laufzeitfehler 1004.
Versuch's vielleicht mal hier mit einer normalen Schleife.

HTH, Bernd
--
Public Sub CSVRead(fname As String)
Dim hfile As Integer ' Filehandle bzw. Dateinummer
Dim lngZeile As Long ' Zeilennummer in gelesenen Daten
Dim intSpalte As Integer ' Spaltenzähler
Dim strAll As String ' die gesamte Datei als ein String
Dim arAll As Variant ' dito, in Records (Zeilen) aufgetrennt
Dim arRow As Variant ' eine Zeile in Felder (Spalten) aufgetrennt

hfile = FreeFile
Open fname For Binary As #hfile
strAll = Space(LOF(hfile))
Get #hfile, , strAll
Close #hfile

' CR LF in LF wandeln
If TranslateCRLF Then strAll = Replace(strAll, vbCrLf, vbLf)

' Zeilenweise splitten, hierbei die " noch stehen lassen
arAll = mySplitDoubled(strAll, IIf(TranslateCRLF, vbLf, RecordSeperator), False)

For lngZeile = 0 To UBound(arAll)
' Spaltenweise aufsplitten, hierbei die " entfernen
arRow = mySplitDoubled(CStr(arAll(lngZeile)), FieldSeparator, True)
For intSpalte = 0 To UBound(arRow)
Cells(lngZeile + 1, intSpalte + 1) = arRow(intSpalte)
Next
Next
End Sub

 

Hi Bernd!

Stimmt, so klappt es! Ist zwar eigentlich schade, daß ich das Format nicht auf Text stellen kann - denn das ist eigentlich garnicht so schlecht, schließlich werden dann keine Zellen verändert (wie z.B. führende Nullen gestrichen) - aber egal, es wird auch so gehen.

Ein allerletztes Problem habe ich trotzdem noch. Wenn ich jetzt das ganze per Makro normal als CSV speichere ist alles bestens. Ich hatte allerdings Probleme damit, daß mein Makro auf einigen Rechnern die CSV mit Komma statt Semikolon als Trennzeichen (aufgrund der versch. VBA-Versionen) exportierte.

Daher habe ich die Datei bisher (bei der ich zuvor manuell die Zeilenumbrüche entfernt hatte) mit diesem Makro exportiert (habe ich über googeln gefunden):

Code:

Das hat bisher super funktioniert. Wenn ich aber Dein Importmakro benutze zerschießt mein Exportmakro plötzlich die CSV und beim nächsten Öffnen/Import sind alle Spalten verrutscht. Hast Du eine Ahnung woran das liegen könnte?

Grüße

Mirko

 

Hallo Mirko,

das Problem liegt wohl hier:

sTxt = sTxt & Cells(iRow, iCol).Value & ";"

Das geht IMHO so nur, wenn folgende Zeichen NICHT in den Zellen vorkommen:

- Zeilenumbrüche
- der Textqualifier, normalerweise das Anführungszeichen "
- der Feldtrenner, im Deutschen das Semikolon, im Englischen das Komma.

Versuch's vielleicht mal so wie unten.

cu, Bernd
--
Option Explicit

Const RecordSeparator As String = vbCrLf
Const FieldSeparator As String = ";"
Const TextQualifier As String = """"

Const TranslateCRLF As Boolean = True

Sub TestWrite()
Call CSVWrite(ActiveSheet.UsedRange, "e:\test\aus.csv")
End Sub

Public Sub CSVWrite(src As Range, fname As String)
Dim handle As Integer ' Filehandle bzw. Dateinummer
Dim i As Long ' Zähler über Zeilen
Dim j As Integer ' Zähler über Spalten
Dim arRow As Variant ' eine Zeile, für die Ausgabe zusammengebaut
Dim sVal As String ' ein Zellenwert
Dim maxcol As Integer ' max. Anzahl an Spalten

handle = FreeFile
maxcol = src.Columns.Count

Redim arRow(1 To maxcol)
Open fname For Output As #handle
For i = 1 To src.Rows.Count
For j = 1 To maxcol
sVal = src(i, j)
' Falls Trennzeichen in der Zelle vorkommen, Spezialbehandlung
If IsSeparatorInside(sVal) Then
' den Textkennzeichner verdoppeln und vorne und hinten anfügen
sVal = TextQualifier & Replace(sVal, TextQualifier, TextQualifier & TextQualifier) & TextQualifier
If TranslateCRLF Then sVal = Replace(sVal, vbLf, vbCrLf)
End If
arRow(j) = sVal
Next j
' Zeile mit Trennzeichen ausgeben
Print #handle, Join(arRow, FieldSeparator); RecordSeparator;
Next i
Close #handle
End Sub

Private Function IsSeparatorInside(s As String) As Boolean
IsSeparatorInside = True

' Test auf das Feldtrennzeichen
If InStr(s, FieldSeparator) Then Exit Function

' Test auf den Recordseparator
If InStr(s, RecordSeparator) Then Exit Function

' Test auf vbCR und vbLF
If InStr(s, vbCr) Then Exit Function
If InStr(s, vbLf) Then Exit Function

' Test auf den Textkennzeichner
If InStr(s, TextQualifier) Then Exit Function

' fertig, keine Sonderbehandlung notwendig
IsSeparatorInside = False
End Function

 

Komisch, er sagt mir dauernd "Variable nicht definiert", und im Debugger markiert er mir "RecordSeparator".

Habe aber

Const RecordSeparator As String = vbCrLf

ganz oben stehen, also als Konstante für alle Subs definiert.

 

Hi Marco,

RecordSeparator, nicht RecordSeperator

war im Read-Teil ein Schreibfehler von mir :-(

cu, Bernd

 

Hi Bernd!

Oh man - da muß ich wohl extrem große Tomaten auf den Augen gehabt haben. Funktioniert hervorragend das ganze. Also, nochmals vielen Dank für Deine Hilfe & die Zeit, die Du für mich geopfert hast *grins

Grüße

Mirko