VBA Tipp: ANSI-String ins UTF8-Format konvertieren

Aus DBWiki
Wechseln zu: Navigation, Suche

Anforderung

Ich möchte einen Text-String vom ANSI-Format (ISO-Format) ins UTF8-Format wahlweise mit oder ohne BOM (Byte Order Mark) konvertieren.
Hinweis: Der ISO-Zeichensatz ist nahezu identisch mit dem ANSI-Zeichensatz.

Lösung 1

Das geht mit der folgenden Funktion, die in einem globalen Modul hinterlegt wird.

In der Funktion wird eine weitere Funktion aus dem DBWiki verwendet: Funktion DateiAuslesen()

Public Function ANSIzuUTF8String(ANSIText As String, _
                                 Optional ByVal ohneBOM As Boolean = False) As String
 
   'Konvertiert einen ANSI-Textstring ins UTF8-Format
   'Late-Binding, kein Verweis auf Microsoft ActiveX Data Objects X.X Library (ADO) notwendig
 
   'Quelle: www.dbwiki.net oder www.dbwiki.de
 
   Const adTypeText = 2
   Const adSaveCreateOverWrite = 2
 
   Dim objStreamANSI As Object 'ADODB.Stream
   Dim objStreamUTF8 As Object 'ADODB.Stream
   Dim strtempdatei As String
   Dim strret As String
 
   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
 
   'String in den Stream übernehmen
   objStreamANSI.WriteText ANSIText
 
   'Streamobjekt Ziel öffnen, Kodierung UTF8-Text
   objStreamUTF8.Type = adTypeText
   objStreamUTF8.Charset = "utf-8"
   objStreamUTF8.Open
 
   'Text vom Streamobjekt Quelle ins Streamobjekt Ziel kopieren
   objStreamANSI.position = 0
   objStreamUTF8.WriteText objStreamANSI.ReadText
 
   'in temporäre UTF8-Datei speichern
   strtempdatei = CurrentProject.Path & "\temp.txt"
   objStreamUTF8.SaveToFile strtempdatei, adSaveCreateOverWrite
 
   'UTF8-Text aus temporärer Datei auslesen
   'Die Funktion "DateiAuslesen" ist im DBWiki zu finden
   strret = DateiAuslesen(strtempdatei)
 
   'BOM (, entspricht den Zeichen 239 187 191) entfernen
   If ohneBOM = True Then
      strret = Replace(strret, Chr(239) & Chr(187) & Chr(191), "", , , vbBinaryCompare)
   End If
 
   'Rückgabewert setzen
   ANSIzuUTF8String = strret
 
   'temporäre Datei löschen
   Kill strtempdatei
 
   'Objekte schließen und Speicher leeren
   objStreamUTF8.Close: Set objStreamUTF8 = Nothing
   objStreamANSI.Close: Set objStreamANSI = Nothing
 
End Function

Aufruf

Anzeige im Direktfenster

   Dim strErgebnis As String
 
   'Beispiel 1: Rückgabewert mit BOM
   strErgebnis = ANSIzuUTF8String("äöüß")
 
   'alternativ Beispiel 2: Rückgabewert ohne BOM
   strErgebnis = ANSIzuUTF8String("äöüß", True)
 
   'Ergebnis im Direktfenster anzeigen
   Debug.Print strErgebnis

Lösung 2

Konvertiert einen Unicode String in ein Utf-8 Byte-Array bzw. konvertiert ein Utf-8 Byte-Array in einen Unicode String.

Folgender Code ist in einem allgemeinen Modul zu verwenden:

Option Explicit
 
'Konstanten aus ADODB
Private Const adCRLF       As Long = -1
Private Const adLF         As Long = 10
 
Private Const adReadLine   As Long = -2
Private Const adWriteLine  As Long = 1
 
Private Const adTypeBinary As Long = 1
Private Const adTypeText   As Long = 2
 
 
Public Function UnicodeToUtf8(Text, Optional NoBOM As Boolean = True) As Byte()
 
   'Eingabe:
   'Text    Variant  Unicode Text, der in Utf-8 umzuwandeln ist
   'NoBOM   Boolean  (Optional) Byte Order Mark verwenden
   '                 True  = ohne Byte Order Mark (Standard)
   '                 False = mit Byte Order Mark
 
   'Rückgabe:
   '                 Utf-8 kodierter Text als Byte-Array
   '                 uninitialisiertes Array, falls Text Null ist
 
   'Windows Zeilenenden (vbCrLf) werden in Unix Zeilenenden (vbLf) umgewandelt
 
   'Quelle: http://www.dbwiki.net
 
 
   Dim stmText As Object
   Dim stmUtf8 As Object
 
   If IsNull(Text) Or IsEmpty(Text) Then Exit Function
 
   Set stmText = CreateObject("ADODB.Stream")
 
   stmText.Open
   stmText.Type = adTypeText
   stmText.LineSeparator = adCRLF
   stmText.Charset = "Unicode"
   stmText.WriteText Text
   stmText.Position = 0
 
   Set stmUtf8 = CreateObject("ADODB.Stream")
   stmUtf8.Open
   stmUtf8.Type = adTypeText
   stmUtf8.LineSeparator = adLF
   stmUtf8.Charset = "UTF-8"
 
   'zeilenweise kopieren, um Zeilenenden zu ändern
   Do Until stmText.EOS
      stmUtf8.WriteText stmText.ReadText(adReadLine), adWriteLine
   Loop
   stmText.Close
 
   'um Typenänderung des Streams zu erlauben
   stmUtf8.Position = 0
   stmUtf8.Type = adTypeBinary
 
   If NoBOM Then stmUtf8.Position = 3
   UnicodeToUtf8 = stmUtf8.Read()
   stmUtf8.Close
 
End Function
 
Public Function Utf8ToUnicode(Utf8) As String
 
   'Eingabe:
   'Utf8    Variant  Utf8 Byte Array, das in Unicode umzuwandeln ist
 
   'Rückgabe:
   '                 Utf-8 kodierter Text als String
   '                 vbNullString, falls Utf8 Null ist
 
   'Unix Zeilenenden (vbLf) werden in Windows Zeilenenden (vbCrLf) umgewandelt
 
   'Quelle: http://www.dbwiki.net
 
 
   Dim stmUtf8 As Object
   Dim stmText As Object
   Dim buf()   As Byte
 
   If IsNull(Utf8) Or IsEmpty(Utf8) Then Exit Function
 
   Set stmUtf8 = CreateObject("ADODB.Stream")
   stmUtf8.Open
   stmUtf8.Type = adTypeBinary
   stmUtf8.Write Utf8
 
   stmUtf8.Position = 0
   If stmUtf8.Size >= 3 Then buf = stmUtf8.Read(3)
 
   stmUtf8.Position = 0
   stmUtf8.Type = adTypeText
   stmUtf8.Charset = "UTF-8"
   stmUtf8.LineSeparator = adLF
 
   If UBound(buf) = 2 Then
      If (buf(0) = &HEF) And (buf(1) = &HBB) And (buf(2) = &HBF) Then
         stmUtf8.Position = 3  'Stream hinter BOM positionieren
      End If
   End If
 
   Set stmText = CreateObject("ADODB.Stream")
 
   stmText.Open
   stmText.Type = adTypeText
   stmText.LineSeparator = adCRLF
   stmText.Charset = "Unicode"
 
   'zeilenweise kopieren, um Zeilenenden zu ändern
   Do Until stmUtf8.EOS
      stmText.WriteText stmUtf8.ReadText(adReadLine), adWriteLine
   Loop
   stmUtf8.Close
 
   stmText.Position = 0
   Utf8ToUnicode = stmText.ReadText
   stmText.Close
 
End Function

Beispiel

Sub Beispiel()
   Dim buf() As Byte
 
   buf = UnicodeToUtf8("„Fix Schwyz!“, quäkt Jürgen blöd vom Paß." & vbCrLf & _
                       "Arrêtez-vous ici, s'il vous plaît.")
   Debug.Print Utf8ToUnicode(buf)
   '==>  „Fix Schwyz!“, quäkt Jürgen blöd vom Paß.
   '==>  Arrêtez-vous ici, s'il vous plaît.
End Sub


Wiki hinweis.png

Anmerkung: API-Methoden, wie sie unter FAQ 0155: Wie konvertiere ich eine VB-Zeichenkette nach UTF-8 oder zurück? zu finden sind, sind schneller und ressourcen-schonender bei der Ausführung.


Wikilinks