kann man das Format einer mit Open file_name_out For Output As #2. von ANSI in UTF-8 ändern? Da Ich die vom Macro erzeugte Datei in einem speziellen Programm verwende, das sonst keine Sonderzeichen anzeigen kann.
Vielen Dank
Markus
Gruß
Reinhard
Option Explicit
Sub AsciiUtf8()
Dim Satz As String
Close
Open "c:\test\MeineAnsi.txt" For Input As #1
Open "c:\test\MeineUtf8.txt" For Output As #2
While Not EOF(1)
Line Input #1, Satz
Print #2, Encode_UTF8(Satz) ' oder Print #2, Ascii2Utf8(Satz)
Wend
Close
End Sub
Public Function Ascii2Utf8(Testo As String) As String
Dim J As Integer
Dim Result As String
For J = 1 To Len(Testo)
If Asc(Mid(Testo, J, 1)) > 127 Then
Result = Result + "" + Hex(Asc(Mid(Testo, J, 1))) + ";"
Else
Result = Result + Mid(Testo, J, 1)
End If
Next
Ascii2Utf8 = Result
End Function
'Voilà , j 'avais besoin de convertir de l'UTF-8 en ANSI et après pas mal de recherches
'je n'ai rien trouvé de concluant, donc je l'ai codé à partir de la RFC.
'Je dépose le code ici dans l'espoir que ça puisse un jour servir à quelqu'un.
'Code source libre de droits.
'EDIT: mise à jour de la fonction isUTF8 par une version plus fiable.
Option Explicit
' Char. number range | UTF-8 octet sequence
' (hexadecimal) | (binary)
' 0000 0000-0000 007F | 0xxxxxxx
' 0000 0080-0000 07FF | 110xxxxx 10xxxxxx
' 0000 0800-0000 FFFF | 1110xxxx 10xxxxxx 10xxxxxx
' the following is not implemented
' 0001 0000-0010 FFFF | 11110xxx 10xxxxxx 10xxxxxx 10xxxxxx
Function Encode_UTF8(astr)
Dim c
Dim n
Dim utftext
utftext = ""
n = 1
Do While n <= Len(astr)
c = AscW(Mid(astr, n, 1))
If c < 128 Then
utftext = utftext + Chr(c)
ElseIf ((c > 127) And (c < 2048)) Then
utftext = utftext + Chr(((c \ 64) Or 192))
utftext = utftext + Chr(((c And 63) Or 128))
Else
utftext = utftext + Chr(((c \ 4096) Or 224))
utftext = utftext + Chr((((c \ 64) And 63) Or 128))
utftext = utftext + Chr(((c And 63) Or 128))
End If
n = n + 1
Loop
Encode_UTF8 = utftext
End Function
' Char. number range | UTF-8 octet sequence
' (hexadecimal) | (binary)
' 0000 0000-0000 007F | 0xxxxxxx
' 0000 0080-0000 07FF | 110xxxxx 10xxxxxx
' 0000 0800-0000 FFFF | 1110xxxx 10xxxxxx 10xxxxxx
' the following is not implemented
' 0001 0000-0010 FFFF | 11110xxx 10xxxxxx 10xxxxxx 10xxxxxx
Function Decode_UTF8(astr)
Dim c0, c1, c2, c3
Dim n
Dim unitext
unitext = ""
n = 1
Do While n <= Len(astr)
c0 = Asc(Mid(astr, n, 1))
If n <= Len(astr) - 1 Then
c1 = Asc(Mid(astr, n + 1, 1))
Else
c1 = 0
End If
If n <= Len(astr) - 2 Then
c2 = Asc(Mid(astr, n + 2, 1))
Else
c2 = 0
End If
If (c0 And 224) = 224 And (c1 And 128) = 128 And (c2 And 128) = 128 Then
unitext = unitext + ChrW((c0 And 15) * 4096 Or (c1 And 60) * 64 Or (c1 And 3) * 64 Or (c2 And 63))
n = n + 3
ElseIf (c0 And 192) = 192 And (c1 And 128) = 128 Then
unitext = unitext + ChrW((c0 And 28) * 1024 Or (c0 And 3) * 64 Or (c1 And 63))
n = n + 2
Else
unitext = unitext + ChrW(c0 And 127)
n = n + 1
End If
Loop
Decode_UTF8 = unitext
End Function
' Char. number range | UTF-8 octet sequence
' (hexadecimal) | (binary)
' 0000 0000-0000 007F | 0xxxxxxx
' 0000 0080-0000 07FF | 110xxxxx 10xxxxxx
' 0000 0800-0000 FFFF | 1110xxxx 10xxxxxx 10xxxxxx
' the following is not implemented
' 0001 0000-0010 FFFF | 11110xxx 10xxxxxx 10xxxxxx 10xxxxxx
Function isUTF8(astr)
Dim c0, c1, c2, c3
Dim n
isUTF8 = False
n = 1
Do While n <= Len(astr)
c0 = Asc(Mid(astr, n, 1))
If n <= Len(astr) - 1 Then
c1 = Asc(Mid(astr, n + 1, 1))
Else
c1 = 0
End If
If n <= Len(astr) - 2 Then
c2 = Asc(Mid(astr, n + 2, 1))
Else
c2 = 0
End If
If (((c0 And 224) / 32 = 6) And ((c1 And 192) / 64 = 2)) Or (((c0 And 240) / 16 = 14) And ((c1 And 192) / 64 = 2) And ((c2 And 192) / 64 = 2)) Then
isUTF8 = True
Exit Function
Else
n = n + 1
End If
Loop
End Function