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

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: Kompletten Inhalt einer Textdatei in eine String-Variable einlesen

Public Function ANSIzuUTF8String(ByVal 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
 
 Dim objStreamANSI As Object 'ADODB.Stream
 Dim objStreamUTF8 As Object 'ADODB.Stream
 Dim strtempdatei As String
 Dim strret As String
 Const adTypeText = 2
 Const adSaveCreateOverWrite = 2
 
 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


Wiki-Links