Thema: VBA UTF8-String decodieren

Hallo Forum.

In einer File, die ich mit VBA einlese, sind Text-Teile im UTF-8-Format enthalten.

Beispiel: Subject: =?utf-8?Q?Schl=C3=BCsselprotokoll?=

Gibt es in VBA eine Funktion, welche den Text "lesbar" macht?

Gruß Joschi

Hallöchen,

ich habe vor längerem mal das genutzt. Die ursprüngliche Quelle (verlinkte Seite) wird inzwischen von meinem Browser blockiert :-(

'

' codiert einen UTF-8 String in UTF-16BE um

' frei nach: [url]http://www.vovisoft.com/unicode/UniFunctions.htm#UTF8ToUniStr[/url]

'

Function FromUTF8String(ByVal s As String) As String

   Dim i As Integer, b(2) As Byte

   i = 1

   s = s & Chr(0) & Chr(0)

   Do While i <= Len(s) - 2

      b(0) = Asc(Mid(s, i, 1))

      b(1) = Asc(Mid(s, i + 1, 1))

      b(2) = Asc(Mid(s, i + 2, 1))

      If (b(0) And &HE0) = &HE0 Then

         FromUTF8String = FromUTF8String & ChrW((b(0) And &HF) * CLng(&H1000) + (b(1) And &H3F) * CLng(&H40) + (b(2) And &H3F))

         i = i + 3

      ElseIf (b(0) And &HC0) = &HC0 Then

         FromUTF8String = FromUTF8String & ChrW((b(0) And &H1F) * &H40 + (b(1) And &H3F))

         i = i + 2

      Else

         FromUTF8String = FromUTF8String & Chr(b(0))

         i = i + 1

      End If

   Loop

End Function

Eine Alternative könnte zuweilen auch das Ersetzen von Zeichengruppen sein, in der Art

    Cells.Replace What:="Ä", Replacement:="Ä", LookAt:=xlPart, SearchOrder _

        :=xlByRows, MatchCase:=True

Hallöchen,

wie gesagt, ggf. kannst Du Zeichen ersetzen ... Wie lautet denn der String lesbar?

Hallo Joschi,

das grösste Problem, wenn man noch auf dem Stand "Basiskenntnisse in VBA" steckt, ist, dass man zwar nach den richtige Begriff googeln, aber die Antworte nicht richtig einordnen kann.
Eine Lösung ist, die Datei über einen ADODB.Stream-Objekt zu lesen, weil diese in der Lage ist, utf-8 vor dem Lesen zu setzen.

Aus der Seite https://www.gebhardter.de/vba-excel/utf-8-und-ansi-daten-per-vba-in-excel-importieren/

Dim oStream As Object

Dim vDaten As Variant



Const vName = "../Pfad/Datei.txt"

    

    Set oStream = CreateObject("ADODB.Stream")

    oStream.Charset = "utf-8"

    oStream.Open

    oStream.LoadFromFile (vName)

    vDaten = oStream.ReadText()

    oStream.Close

    Set oStream = Nothing

    vDaten = Split(vDaten, vbCrLf)

(ungetestet. Sieht aber schlüssig aus)

VG
Yal

Hallo Yal.

Danke für Deinen Hinweis auf ADODB. Ich habe das getestet, aber leider wurden die in meinem Beispiel genannten UTF-Daten nicht ersetzt.

Ich setzte den Status absichtlich nicht mehr auf "offen", weil ich inzwischen die Hoffnung auf eine brauchbare Lösung aufgegeben habe. Ich habe mich für die Lösung entschieden, bei der bestimmte Zeicheneketten ersetzt werden. Aktuell ich nur den Ersatz der deutschen Umlaute realisiert.

Gruß Joschi

.. wie gesagt, nur weil UTF8 da steht muss es kein UTF8 sein. Der korrekte Code für ein ü wäre z.B. C3BC und nicht =C3=BC und den sieht man z.B. in einem Hexeditor... Wenn man utf8 als Text einliest, dann bekommt man statt des ü ein Zeichen wie in meinem ersten längeren codebeispiel - konkret "ü"

Hallo.

jetzt habe ich doch noch zwei Fragen:

Bei meinem Test ist jetzt auch ein Zeichen aufgetreten, welches kein deutscher Umlaut war:
=?utf-8?Q?=E2=9C=85?=

Es ist ein Haken mit grünem Hintergrund (ich frage mich, was so etwas im Betreff einer Mail zu suchen hat).

1. So wie es aussieht, ist dieser Zeichenstring länger als die der Umlaute.

2. Wie kann ich erkennen bzw errechnen, wie lange der Zeichenstring für ein bestimmtes Zeichen ist? Wenn ich den Code nicht kenne, sollte ich ihn durch ein anderes Zeichen (?) ersetzen

Gruß Joschi

Hi,
deine Texte scheinen aus der Web-Welt zu kommen:
%E2%80%9C = Anführungszeichen , Umlaute dito
schau mal unter https://www.w3schools.com/tags/ref_urlencode.ASP .
Die Wandlung vom Steuerzeichen % in = muss schon unterwegs passiert sein, vlt hat der Admin eine Protokolldatei geöffnet/konvertiert.
In der 3.Spalte kannst du die notwendigen Codes alle abgreifen und per Case verarzten.
hth
Ulf

https://www.fileformat.info/info/charset/UTF-8/list.htm

Eventuell beginnt ein Zeichencode mit = und hat danach 2 Stellen. Wenn nach den 2 Stellen wieder ein = kommt, könnte beides zusammengehören.
Wenn Du Dir die verlinkte Liste anschaust, siehst Du eventuell weitere Möglichkeiten zum Erkennen der "Stellenanzahl"

Hallo

Den Code in ein allgemeines Modul.
Du kannst SuchenKonvertieren auch als UDF aufrufen oder wie in Main über einen Bereich laufen lassen.

Option Explicit



Sub Main()

    Dim i  As Long

    For i = 1 To 8

        With Worksheets("Tabelle1")

            .Cells(i, 2).Value = SuchenKonvertieren(.Cells(i, 1).Value)

        End With

    Next

End Sub



Function SuchenKonvertieren(InString As String) As String

    

    Dim NeuString As String

    Dim PosStart As Long

    Dim PosEnde As Long

    

    PosStart = InStr(1, InString, "=?")

    PosEnde = 1

    NeuString = ""

    

    If PosStart > 0 Then

        While PosStart > 0

            NeuString = NeuString & Mid(InString, PosEnde, PosStart - PosEnde)

            

            PosEnde = InStr(PosStart + 10, InString, "?=")

            NeuString = NeuString & ConvertUTF(Mid(InString, PosStart, PosEnde - PosStart))

            

            PosStart = InStr(PosStart + 10, InString, "=?")

            

            PosEnde = PosEnde + 2

            If PosStart = 0 Then

                NeuString = NeuString & Mid(InString, PosEnde, 9999)

            End If

        Wend

    Else

        NeuString = InString

    End If

    SuchenKonvertieren = NeuString

    



End Function



Private Function ConvertUTF(myString) As String



    Dim oStream As Object

    Dim MyUTF() As Byte

    

    Dim i As Long

    Dim Anz As Long

    

    

    ReDim MyUTF(999)

    

    Anz = 0

    i = 11

    

    While i <= Len(myString)

        If Mid(myString, i, 1) = "=" Then

            MyUTF(Anz) = CByte(WorksheetFunction.Hex2Dec(Mid(myString, i + 1, 2)))

            Anz = Anz + 1

            i = i + 3

        Else

            MyUTF(Anz) = CByte(Asc(Mid(myString, i, 1)))

            Anz = Anz + 1

            i = i + 1

        End If

    

    Wend

    ReDim Preserve MyUTF(Anz - 1)

        

    Set oStream = CreateObject("ADODB.Stream")

    oStream.Charset = "utf-8"

    oStream.Open

    oStream.Type = 1 'adTypeBinary

    oStream.Position = 0

    oStream.Write MyUTF()

    oStream.SetEOS

    oStream.Position = 0

    oStream.Type = 2 'adTypeText

    

    ConvertUTF = oStream.ReadText()

    

    oStream.Close

    Set oStream = Nothing

End Function

Peter

Hallo

Hier meine Testdatei

https://www.herber.de/bbs/user/175314.xlsm

Peter

Hallo Peter.

Recht herzlichen Dank für Dein Beispiel. Ich bin echt beeindruckt. Funktioniert astrein.

Das ist die erste Mappe, in der ADODB genutzt wird, und zuvor kein Verweis gesetzt werden muss; wieder etwas dazugelernt. Und das Tolle: ich habe jeden Schritt im Code verstanden.

Noch ein kleiner Hinweis: der Code funktioniert nur auf "=?utf-8?Q?=". In meinen Daten habe ich auch den String "'=?utf-8?B?" gefunden. Damit hat Dein Code - wie von mir erwartet - Probleme.

Gruß Joschi

Hallo

Sollte auch mit B? funktionieren, da ich nur nach "=?" suche und dann 10 Zeichen abschneide.
Kannst Du mir den Beispielstring mit B? schicken.

Mfg.
Peter

Hallo Peter,

das sind 4 Zeilen aus einer Mail:

Date: 16 Jan 2024 13:25:39 +0000
Subject: =?utf-8?B?SWhyIGJ1aGw6S29udG8gaXN0IGdlbMO2c2NodA==?=
Content-Type: text/html; charset=utf-8
Content-Transfer-Encoding: base64

In über 100 Mail sind nur 4 mit solchen Daten. Und davon jeweils 2 von zwei unterschiedlichen Absendern. Ich vermute, es liegt an der Mail-Software beim Absender, welche UTF-Version zum Tragen kommt.

Gruß Joschi

Hallo

Das ist ein Base64 kodierter UTF-8 String

Subject: =?utf-8?B?SWhyIGJ1aGw6S29udG8gaXN0IGdlbMO2c2NodA==?=

Der codierte Teil steht zwischen "B?" und "?=", d.h. "SWhyIGJ1aGw6S29udG8gaXN0IGdlbMO2c2NodA=="

Interaktiv kannst Du den String auf der Seite https://www.base64decode.org/ decodieren (Ergebnis: "Ihr buhl:Konto ist gelöscht"

Als VBA Program

Sub TestBase64()



    Dim base64Str As String

    Dim vArr As Variant

    Dim oStream As Object

    

    

    base64Str = "SWhyIGJ1aGw6S29udG8gaXN0IGdlbMO2c2NodA=="

    vArr = Base64ToArray(base64Str)

    

    Set oStream = CreateObject("ADODB.Stream")

    oStream.Charset = "utf-8"

    oStream.Open

    oStream.Type = 1 'adTypeBinary

    oStream.Position = 0

    oStream.Write vArr

    oStream.SetEOS

    oStream.Position = 0

    oStream.Type = 2 'adTypeText

    

    MsgBox (oStream.ReadText())

    

    oStream.Close

    Set oStream = Nothing



End Sub





Private Function Base64ToArray(base64Text As String) As Variant

    

    Dim xmlDoc As Object

    Dim xmlNode As Object

    

    Set xmlDoc = CreateObject("MSXML2.DOMDocument")

    Set xmlNode = xmlDoc.createElement("b64")

    

    xmlNode.DataType = "bin.base64"

    xmlNode.Text = base64Text

    

    Base64ToArray = xmlNode.nodeTypedValue

  

End Function

Das ganze zu automatisieren überlasse ich Dir.

Peter

Hallo Peter.

Danke für Deinen Nachtrag. Den ersten Schritt der Anpassung habe ich schon gemacht, und mir den entsprechenden String aus der Zeile herausgefiltert und erfolgreich übersetzt. Das muss ich nun in Deinen ersten Code einbauen. Dort wird dann geprüft, welche Art der Verschlüsselung vorliegt, um dann die entsprechenden Routinen aufzurufen.

Ich hatte nicht gedacht, dass ich nach dem Zeitpunkt, als das Thema für mich als "ungelöst" erledigt war, doch noch eine gute Lösung bekomme.

Gruß Joschi

Hallo schauan.

Danke für Deinen Code. Leider funktioniert er nicht. Möglicherweise muss ich die Eingabedaten zuerst aufbereiten. Ich habe der Funktion den kompletten String - wie im Thread gezeigt - übergeben, und habe die identischen Daten zurückbekommen.

Gruß Joschi

Hallöchen,

nur weil in der Zeichenkette utf8 steht muss es ja kein utf8 sein ;-) Falls Dein utf8 File nicht gerade sensible Daten enthält, kannst Du es vielleicht mal zwecks Test hier hochladen.

=C3=BC müsste ja für ü stehen, also z.B.

Cells.Replace What:="=C3=BC", Replacement:="ü", LookAt:=xlPart, SearchOrder _

        :=xlByRows, MatchCase:=True

und dann schaust Du, was noch alles wie verschlüsselt ist. Da kommt dann eine mehrfache Ersetzung raus, im Prinzip - aber dann mit anderen What's, was in der Art:

Sub convertText()



    Cells.Replace What:="Ä", Replacement:="Ä", LookAt:=xlPart, SearchOrder _

        :=xlByRows, MatchCase:=True

    Cells.Replace What:="ä", Replacement:="ä", LookAt:=xlPart, SearchOrder _

        :=xlByRows, MatchCase:=True

    Cells.Replace What:="Ö", Replacement:="Ö", LookAt:=xlPart, SearchOrder _

        :=xlByRows, MatchCase:=True

    Cells.Replace What:="ö", Replacement:="ö", LookAt:=xlPart, SearchOrder _

        :=xlByRows, MatchCase:=True

    Cells.Replace What:="Ãœ", Replacement:="Ü", LookAt:=xlPart, SearchOrder _

        :=xlByRows, MatchCase:=True

    Cells.Replace What:="ü", Replacement:="ü", LookAt:=xlPart, SearchOrder _

        :=xlByRows, MatchCase:=True

    Cells.Replace What:="ß", Replacement:="ß", LookAt:=xlPart, SearchOrder _

        :=xlByRows, MatchCase:=True

    Cells.Replace What:="á", Replacement:="á", LookAt:=xlPart, SearchOrder _

        :=xlByRows, MatchCase:=True

    Cells.Replace What:="é", Replacement:="é", LookAt:=xlPart, SearchOrder _

        :=xlByRows, MatchCase:=True

    Cells.Replace What:="è", Replacement:="è", LookAt:=xlPart, SearchOrder _

        :=xlByRows, MatchCase:=True

End Sub

Hallo schauan.

Dein Code setzt voraus, dass sich die Daten in einem Tabellenblatt befinden. Das habe ich nie gesagt.

Natürlich könnte ich auch auf einen String ein "Replace" machen. Doch das funktioniert nicht, da im String für das eigentliche Zeichen 2 Stellen verwendet werden. Beide müssten durch den Replace durch ein einzelnes Zeichen ersetzt werden. Außerdem bleiben die restlichen Daten, die zum UTF gehören, weiterhin bestehen. Sorry. Das funktioniert so nicht.

Ich habe den String testweise zwei mal in ein Tabellenblatt geschrieben und Deinen Code
"Cells.Replace What:="=C3=BC", Replacement:="ü", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True" ausgeführt

Das Ergebnis: "=?utf-8?Q?Schlüsselprotokoll?="
Erwartet hätte ich "Schlüsselprotokoll"

Gruß Joschi

Hallöchen,

das Du den Code auf eine Zelle anwenden musst hab ich auch nicht gesagt - da steht ja "im Prinzip". Ich habe auch geschrieben, dass da eine mehrfache Ersetzung raus kommt - also für eine Lösung. Du müsstest alle zu ersetzenden Zeichenfolgen mal auflisten und dann programmieren, wie ich es für das ü gemacht habe.

Es ist auch nicht unbedingt sinnvoll, eine Zelle mehrfach zu ersetzen. Man übergibt den String an das Sub (oder eine Function) und ersetzt dann im String die Zeichen. Das mit der Stringübergabe hattest Du doch schon mit der Funktion probiert, weist also, wie das geht.

Also z.B.

Function convertText(strString as String) As String

strString = Replace(strString,"=C3=BC","ü")'auf die Nennung der Parameter kann verzichtet werden

strString = Replace(strString,"wasauchimmer","ä")

'...

convertText = strString

End Function

Man kann die Transformation in der Funktion bis zum Ende in eine temporäre Variable speichern und erst am Ende an die Funktion zurückgeben, z.B.

Function convertText(strString as String) As String

Dim tmpString as String

tmpString = strString

tmpString = Replace(tmpString,"=C3=BC","ü")'auf die Nennung der Parameter kann verzichtet werden

tmpString = Replace(tmpString,"wasauchimmer","ä")

'...

convertText = tmpString

End Function

Hallo schauan.

Der von mir genannte String ist eine Zeile aus einer als EML erportierten Mail. Es ist nicht so, dass die gesamte Mail im UTF-8-Format ist. Es handelt sich wirklich nur um diese Zeile. Und der Betreff der entsprechenden Mail ist wichtig und sollte "lesbar" sein.

Gruß Joschi