Public Function Decode_Quotet_Printable(ByVal Text As String) As String
Dim Start As Integer
Dim Zeichen1, Zeichen2
 
Start = 0
Do
    Start = Start + 1
    Start = InStr(Start, Text, "=") 'Vorkommen vom = Zeichen suchen
 
    'Wenn nach = vbCrLf dann Zeilenwechsel
    Zeichen1 = Mid(Text, Start + 1, 2)
    If Zeichen1 = vbCrLf Then
        Text = Left(Text, Start - 1) & Mid(Text, Start + 3)
        Start = Start - 1
        GoTo Weiter
    End If
 
    'Nach = müssen 2 Zeichen von 0 bis 9 oder A bis F stehen
    Zeichen1 = Mid(Text, Start + 1, 1)
    If IsNumeric(Zeichen1) = False Then
        Zeichen1 = AscW(Zeichen1)
        If Zeichen1 > 70 Or Zeichen1 < 65 Then GoTo Weiter 'nicht A bis F
    End If
 
    Zeichen2 = Mid(Text, Start + 2, 1)
    If IsNumeric(Zeichen2) = False Then
        Zeichen2 = AscW(Zeichen2)
        If Zeichen2 > 70 Or Zeichen2 < 65 Then GoTo Weiter 'nicht A bis F
    End If
 
    '=> es handelt sich um ein HEX Code
    Text = Left(Text, Start - 1) & ChrW("&H" & Mid(Text, Start + 1, 2)) & Mid( _
      Text, Start + 3)
 
Weiter:
Loop Until Start = 0
 
Decode_Quotet_Printable = Text
 
End Function

Dekodierter_Emailtext = Decode_Quotet_Printable(Emailtext)