1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
| 'https://www.developpez.net/forums/d2118909/logiciels/microsoft-office/general-vba/fonctions-codage-decodage-texte-utf-8-vba/
'https://www.di-mgt.com.au/howto-convert-vba-unicode-to-utf8.html
Private Const CP_UTF8 = 65001
Private Declare PtrSafe Function MultiByteToWideChar Lib "kernel32" (ByVal CodePage As Long, _
ByVal dwFlags As Long, ByVal lpMultiByteStr As LongPtr, _
ByVal cchMultiByte As Long, ByVal lpWideCharStr As LongPtr, _
ByVal cchWideChar As Long) As Long
Private Declare PtrSafe Function WideCharToMultiByte Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, _
ByVal lpWideCharStr As LongPtr, ByVal cchWideChar As Long, _
ByVal lpMultiByteStr As LongPtr, ByVal cbMultiByte As Long, _
ByVal lpDefaultChar As Long, ByVal lpUsedDefaultChar As Long) As Long
'------------------------------------------------------------------------------------------------
Sub ExempleLectureFichierTexte()
'------------------------------------------------------------------------------------------------
Dim MonFichier As String
MonFichier = "D:\Temp\phraseAvecAccents_UTF8.txt"
Dim IndexFichier As Integer
Dim Lecture As String
IndexFichier = FreeFile()
Open MonFichier For Binary Access Read As #IndexFichier
Lecture = Space$(LOF(IndexFichier))
Get #IndexFichier, , Lecture
Close #IndexFichier
Lecture = ConvertUTF8ToString(Lecture)
MsgBox Lecture
End Sub
'------------------------------------------------------------------------------------------------
Public Function ConvertStringToUTF8(StrInput As String) As String
'------------------------------------------------------------------------------------------------
Dim nBytes As Long, abBuffer() As Byte, i As Long
If Len(StrInput) > 0 Then
' Get length in bytes *including* terminating null
nBytes = WideCharToMultiByte(CP_UTF8, 0&, ByVal StrPtr(StrInput), -1, 0&, 0&, 0&, 0&)
' We don't want the terminating null in our byte array, so ask for `nBytes-1` bytes
ReDim abBuffer(nBytes - 2) ' NB ReDim with one less byte than you need
nBytes = WideCharToMultiByte(CP_UTF8, 0&, ByVal StrPtr(StrInput), -1, ByVal VarPtr(abBuffer(0)), nBytes - 1, 0&, 0&)
' Génèration d'une chaîne à partir du tableau:
For i = LBound(abBuffer) To UBound(abBuffer)
ConvertStringToUTF8 = ConvertStringToUTF8 & Chr(abBuffer(i))
Next i
End If
End Function
'------------------------------------------------------------------------------------------------
Private Function sUTF8ToUni(bySrc() As Byte) As String
'------------------------------------------------------------------------------------------------
' Converts a UTF-8 byte array to a Unicode string
Dim lBytes As Long, lNC As Long, lRet As Long
lBytes = UBound(bySrc) - LBound(bySrc) + 1
lNC = lBytes
sUTF8ToUni = String$(lNC, Chr(0))
lRet = MultiByteToWideChar(CP_UTF8, 0, VarPtr(bySrc(LBound(bySrc))), lBytes, StrPtr(sUTF8ToUni), lNC)
sUTF8ToUni = Left$(sUTF8ToUni, lRet)
End Function
'------------------------------------------------------------------------------------------------
Public Function ConvertUTF8ToString(UTF8String As String) As String
'------------------------------------------------------------------------------------------------
Dim bData() As Byte, sData As String, lSize As Long, i As Long
sData = UTF8String
lSize = Len(sData)
If lSize > 0 Then
ReDim bData(0 To lSize - 1)
For i = 1 To lSize
bData(i - 1) = Asc(Mid(sData, i, 1))
Next i
' Convert all the data to Unicode
sData = sUTF8ToUni(bData)
Else
sData = ""
End If
ConvertUTF8ToString = sData
End Function
'------------------------------------------------------------------------------------------------
'------------------------------------------------------------------------------------------------ |
Import HTML Convertion UTF
Répondre avec citation
Envoyé par kitcarflo
Partager