CSV erstellen ohne Umbruch in letzter Zeile
01.10.2007 14:24:00
AndreasKehr
ich benötige mal wieder eue Hilfe.
Mittels einem Makro erstelle ich aus einem Bestimmten Arbeitsblatt eine CSV-Datei die unter Stammdaten.txt abgespeichert wird. In dieser Datei darf in der letzten Zeile kein Zeilenumbruch mehr stattfinden. Diese Datei wird weiterverarbeitet und dadurch kommt es zu Fehlermeldungen.
Hier mal das benutzte Makro:
Sub SaveCSV_test()
' Speichert den Inhalt eines Arbeitsblatts als CSV-Datei
' in vier unterschiedliche verzeichnisse
' mit wählbarem Trennzeichen und Maskierung von Einträgen
Dim Bereich As Object, Zeile As Object, Zelle As Object
Dim strTemp As String
Dim strDateiname As String
Dim strTrennzeichen As String
Dim strMappenpfad As String
strMappenpfad = ActiveWorkbook.FullName
strMappenpfad = Replace(strMappenpfad, ".xls", ".csv")
' Namen und Speicherpfad wählen
strDateiname = "\\Datsi\Datsi-Druck-Prod\MDE-Prod\MDE01_kehr\stammdaten.txt"
If strDateiname = "" Then Exit Sub
'strTrennzeichen = Angabe des vTrennzeichens
strTrennzeichen = ";"
If strTrennzeichen = "" Then Exit Sub
'Zu exportierender Bereich festlegen
Set Bereich = Worksheets("scanner_stamm").UsedRange
Open strDateiname For Output As #1
For Each Zeile In Bereich.Rows
For Each Zelle In Zeile.Cells
If InStr(1, Zelle.Text, strTrennzeichen) > 0 Then
'Zellen, die ein Trennzeichen beinhalten in Anführungsstriche setzen
strTemp = strTemp & """" & CStr(Zelle.Text) & """" & strTrennzeichen
Else
strTemp = strTemp & CStr(Zelle.Text) & strTrennzeichen
End If
Next
If Right(strTemp, 1) = strTrennzeichen Then strTemp = Left(strTemp, Len(strTemp) - 1)
Print #1, strTemp
strTemp = ""
Next
Close #1
Set Bereich = Nothing
MsgBox "Datei wurde exportiert nach" & vbCrLf & strDateiname
End Sub
Die erstellte txt Datei sieht folgendermassen aus:
0104250220300190;12;A33 A2 ;500
0104250220300275;12;A38 A1 ;450
0104250220300305;12;A38 A2 ;450
0104250220300343;12;A43 A1 ;350
0104250220300374;12;A43 A2 ;350
Ich hoffe ihr könnt mir helfen
Grüsse Andreas