Quelltext der Seite Office:Excel Echter CSV Export

[[Kategorie:Office]][[Kategorie:Excel]][[Kategorie:VBA]]
Wenn eine Tabelle in Excel als '''''.csv''''' gespeichert wird, handelt es sich hierbei nicht um eine echte CSV Datei - Excel benutzt z.B. kein Komma als Trennzeichen. Mit nachfolgendem VBA Script geht es doch:

<syntaxhighlight lang="vb">
 
Sub SaveCSV()
' Speichert den Inhalt eines Arbeitsblatts als CSV-Datei
' mit wählbarem Trennzeichen und Maskierung von Einträgen
' von Nils Kaczenski (Vorname at nachname .de), 30.1.2003
' Ohne Gewähr!
' Überarbeitet Dezember 2008 durch Bernhard Linz,
' DATAGROUP Bremen GmbH
' Bernhard.Linz@datagroup.de
' Export wurde angepasst damit Zellen, die mit ####### angezeigt werden
' auch richtig mit Wert und nicht mit #### exportiert werden 
 
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")
 
strDateiname = InputBox("Wie soll die CSV-Datei heißen (inkl. Pfad)?", "CSV-Export", strMappenpfad)
If strDateiname = "" Then Exit Sub
 
strTrennzeichen = InputBox("Welches Trennzeichen soll verwendet werden?", "CSV-Export", ",")
If strTrennzeichen = "" Then Exit Sub
 
  Set Bereich = ActiveSheet.UsedRange
 
  Open strDateiname For Output As #1
 
  For Each Zeile In Bereich.Rows
    For Each Zelle In Zeile.Cells
      If Zelle.Value = 0 Then
        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
      Else
        If InStr(1, Zelle.Value, strTrennzeichen) > 0 Then
            'Zellen, die ein Trennzeichen beinhalten in Anführungsstriche setzen
            strTemp = strTemp & """" & CStr(Zelle.Value) & """" & strTrennzeichen
        Else
            strTemp = strTemp & CStr(Zelle.Value) & strTrennzeichen
        End If
      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
 
</syntaxhighlight>
<comments />