Soprani Software

Jemand verlangt von Ihnen eine #.csv-Datei in #UTF-8 ohne #BOM? Spricht der Suaheli? Nein – das ist ein legitimes Anliegen … (Comma Separated Values in der Datei, in der Zeichencodierung UTF-8, und ohne Signatur). Und wie lösen wir das?

Nicht ohne #VBA – leider. Es gibt beim DATEI > Speichern Unter > Tools > Weboptionen keine UTF-8 ohne BOM –Codierung. Der Ansatz ist zunächst derselbe wie vorgestern beschrieben – Sie erzeugen ein Hilfstabellenblatt, das die Daten exportfertig in einer Spalte beinhaltet, die Trennzeichen und Hochkommata müssen Sie selbst hineinbasteln.

Den Export erledigt jetzt keine Excel-Funktionalität, sondern ein Codeschnipsel:

Sub Export2CSVUTF8ohneBOM()
Dim cSh As Worksheet
Dim myRow As Long
Dim UTFStream As Object
Dim BinaryStream As Object

    Set cSh = ThisWorkbook.Worksheets("Export CSV")
    On Error GoTo myFault
    Set UTFStream = CreateObject("adodb.stream") 'Die Ausgabe erfolgt mit ADODb Stream
    UTFStream.Type = adTypeText
    UTFStream.Mode = adModeReadWrite
    UTFStream.Charset = "UTF-8" 'hier wird die Codierung vorgegeben
    UTFStream.LineSeparator = adLF
    UTFStream.Open
    For myRow = 1 To cSh.Range("A1").End(xlDown).Row
        If Not IsEmpty(cSh.Range("A" & myRow)) Then
            UTFStream.WriteText (cSh.Cells(myRow, 1)), adWriteLine
        End If
    Next myRow
    'Ergebnis ist jetzt UTF-8 mit BOM - es gibt keine Einstellung für "ohne BOM", daher kommt jetzt der ultimative Trick
    myRow = -1
    'wir erstellen einen zweiten stream
    Set BinaryStream = CreateObject("adodb.stream")
    BinaryStream.Type = adTypeBinary
    BinaryStream.Mode = adModeReadWrite
    BinaryStream.Open
    UTFStream.Position = 3 'überspringen BOM (die ersten 3 Zeichen)
    UTFStream.CopyTo BinaryStream 'jetzt wird der ursprünglich erzeugte Stream kopiert, aber BOM fällt weg
    'den ersten Stream braucht jetzt kein Mensch mehr
    UTFStream.Flush
    UTFStream.Close 'Ergebnis speichern
    BinaryStream.SaveToFile ThisWorkbook.Path & "\Datei_" & Format(Now, "yyyymmdd_hhnnss") & ".csv", adSaveCreateOverWrite 'Speichern unter dem hier erzeugten Dateinamen
    BinaryStream.Flush
    BinaryStream.Close
    Set UTFStream = Nothing
    Set BinaryStream = Nothing
    MsgBox "Export finished to file " & ThisWorkbook.Path & "\Events_" &    Format(Now, "yyyymmdd_hhnnss") & ".csv", vbOKOnly, "Export"
    Set cSh = Nothing
    Exit Sub

myFault:
    If myRow = -1 Then
        MsgBox "Problems on saving the file - make sure that the ThisWorkbook.Path is a local path (not OneDrive or SharePoint).", vbOKOnly, "Save problem"
    Else
        MsgBox Err.Number & "-" & Err.Description & vbCrLf & " when exporting row #" & myRow & "." & vbCrLf _
& "Please correct data and try again.", vbOKOnly, "Error"
        Resume Next
    End If
End Sub