VBA UTF-8 ohne BOM speichern
10.03.2020 11:20:17
Nico
ich versuche verzweifelt seit mehreren Tagen eine aus Excel erstellte ANSI Datei ins UTF-8 Format ohne BOM zu konvertieren. In dem Code den ich verwende klappt die Umwandlung von ANSI nach UTF-8 Problemlos, nur wenn ich versuche das BOM zu entfernen, hab ich die Datei am Ende UCS-2 Little Endian kodiert vorliegen.
Hier der Code den ich verwende:
Public Function AnsiZuUtf8Datei(Dateipfad As String, _
Optional ByVal ohneBOM As Boolean) As Boolean
'Konvertiert eine ANSI-Text-Datei ins UTF8-Format
'verwendet Late-Binding, weswegen kein Verweis auf
'Microsoft ActiveX Data Objects X.X Library (ADO) notwendig ist
'Quelle: www.dbwiki.net oder www.dbwiki.de
Const adTypeBinary As Long = 1
Const adTypeText As Long = 2
Const adSaveCreateOverWrite As Long = 2
Dim objStreamUTF8 As Object 'ADODB.Stream
Dim objStreamANSI As Object 'ADODB.Stream
Dim objStreamOhneBOM As Object 'ADODB.Stream
Dim DateipfadohneBom As String
DateipfadohneBom = Dateipfad & ".txtobom"
On Error Resume Next
Set objStreamANSI = CreateObject("ADODB.Stream")
Set objStreamUTF8 = CreateObject("ADODB.Stream")
'Streamobjekt Quelle öffnen, Kodierung ANSI-Text
objStreamANSI.Type = adTypeText
objStreamANSI.Charset = "windows-1252"
objStreamANSI.Open
'ANSI-Textdatei-Inhalt hereinladen
objStreamANSI.LoadFromFile Dateipfad
'Streamobjekt Ziel öffnen, Kodierung UTF8-Text
objStreamUTF8.Type = adTypeText
objStreamUTF8.Charset = "utf-8"
objStreamUTF8.Open
'Text vom Streamobjekt Quelle ins Streamobjekt Ziel kopieren
objStreamUTF8.WriteText objStreamANSI.ReadText
'ohne Byte Order Mark speichern
If ohneBOM Then
'Code zum entfernen der Steuerzeichen
'strret = Replace(strret, Chr(239) & Chr(187) & Chr(191), "", , , vbBinaryCompare)
'neues Stream-Objekt anlegen
Set objStreamOhneBOM = CreateObject("ADODB.Stream")
'öffnen
objStreamOhneBOM.Open
'als Binär-Typ auslegen
objStreamUTF8.Type = adTypeBinary
'Position hint BOM setzen
objStreamUTF8.Position = 3
'Stream ab Position kopieren
objStreamUTF8.CopyTo objStreamOhneBOM
'Stream speichern (Datei wird überschrieben)
objStreamOhneBOM.SaveToFile DateipfadohneBom, adSaveCreateOverWrite
'und schließen
objStreamOhneBOM.Close
Else
'UTF8-Text in gleiche Datei speichern (Datei wird überschrieben)
objStreamUTF8.SaveToFile Dateipfad, adSaveCreateOverWrite
End If
'Objekte schließen
objStreamUTF8.Close
objStreamANSI.Close
'Rückgabewert setzen
AnsiZuUtf8Datei = CBool(Err.Number = 0)
End Function