Discussion :

[kitcarflo]

Bonjour à tous.

J'ai un soucis que je n'arrive pas à resoudre. J'ai essayé plusieurs code de conversion trouvé sur le net. Mais au final rien ne donne satisfaction.

J'ai un fichier HTML et lorsque je l'ouvre sous notepad++, celui ci me dit qu'il est encodé en UTF-8. Mais lorsque je lie le fichier avec excel via une macro

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
While Not EOF(IndexFichier)
    Line Input #IndexFichier, ContenuLigne  ......

j'obtiens tous les symboles de type "é", "à", "^" ..... sous forme de "éo".

Cela fait pas mal de temps que je bloque dessus. Auriez vous une solution ?

Merci à vous.

[jurassic pork]

Hello,
Pour convertir le texte d'un fichier texte utf-8 en texte utilisable dans une macro VBA , on peut utiliser ADODB qui arrive à convertir le texte d'un fichier texte dont on spécifie l'encodage en String VBA.
Voici un exemple qui lit un fichier encodé en UTF-8 (en pièce jointe) et visualise le contenu dans une MessageBox.
1 - En utilisant une fonction qui ne prend pas en compte l'encodage (LireFichierTexte).
2 - En utilisant une fonction qui prend en compte l'encodage et qui utilise pour cela AdoDb (LireFicTexteCharset).

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Option Explicit
 
Private Const adReadAll = -1
Private Const adTypeBinary = 1
Private Const adTypeText = 2
 
Function LireFichierTexte(ByVal MonFichier As String) As String
    On Error GoTo LireFichierTexteErreur
    Dim IndexFichier As Integer
    IndexFichier = FreeFile()
    Open MonFichier For Binary Access Read As #IndexFichier
    LireFichierTexte = Space$(LOF(IndexFichier))
    Get #IndexFichier, , LireFichierTexte: Close #IndexFichier
    Exit Function
LireFichierTexteErreur:
    Close #IndexFichier: LireFichierTexte = ""
End Function
 
Function LireFicTexteCharset(ByVal FicName, ByVal Charset) As String
    Dim strText
    With CreateObject("ADODB.Stream")
        .Open: .Type = adTypeBinary: .LoadFromFile FicName
        .Type = adTypeText: .Charset = Charset
         strText = .ReadText(adReadAll)
         LireFicTexteCharset = strText
        .Close
    End With
End Function
 
Sub ExempleLectureFichierTexte()
    Dim MonFichier As String
    On Error GoTo TestErreur
    MonFichier = "D:\Temp\phraseAvecAccents_UTF8.txt"
    MsgBox LireFichierTexte(MonFichier)
    MsgBox LireFicTexteCharset(MonFichier, "utf-8")
    Exit Sub
TestErreur:
    MsgBox "Le fichier n'a pas pu être lu..."
End Sub

Résultat de la fonction LireFichierTexte :


Résultat de la fonction LireFicTexteCharset :



Corrections orthographiques :
Convertion -> Conversion
J'ai un soucis que je n'arrive pas à resoudre. J'ai essayé plusieurs code de conversion trouvé sur le net. ->J'ai un souci que je n'arrive pas à résoudre. J'ai essayé plusieurs codes de conversion trouvés sur le net.

Ami calmant, J.P

[kitcarflo]

Bonjour.

Merci pour ta réponse. J'ai regardé ton code, mais je ne crois pas pouvoir l'adapter car j'ai besoin de lire le fichier ligne par ligne, pour extraire, suivant des conditions, quelques informations et les garder. Hors avec la méthode que tu propose et qui marche super bien, c'est tout le texte qui est lue et pas ligne par ligne.

[jurassic pork]

tu peux essayer d'utiliser la fonction Utf2Uni qui se trouve dans le billet de Pierre Fauconnier Apprendre comment convertir une chaine en utf-8 avec VBA
Exemple d'utilisation :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
Sub LireFichierUTF8()
    Dim ContenuLigne As String
    Dim MonFichier As String
    Dim IndexFichier As Integer
    MonFichier = "D:\Temp\phrasesAvecAccents_UTF8.txt"
    IndexFichier = FreeFile()
    Open MonFichier For Input As #IndexFichier
    While Not EOF(IndexFichier)
          Line Input #IndexFichier, ContenuLigne
          Debug.Print Utf2Uni(ContenuLigne)
    Wend
    Close #IndexFichier
End Sub

[kitcarflo]

J'étais tombé sur ce code et je pensais que sa solutionnerait mon problème, mais il ne marche pas. En fait il se passe rien.

[laurent_ott]

J'étais tombé sur ce code et je pensais que sa solutionnerait mon problème, mais il ne marche pas. En fait il se passe rien.

Bonjour,
Essayez avec la fonction : ExempleLectureFichierTexte où vous remplacerez (en ligne 20) "D:\Temp\phraseAvecAccents_UTF8.txt" par votre fichier.

Code VBA :

Sélectionner tout - Visualiser dans une fenêtre à part

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
'------------------------------------------------------------------------------------------------
'------------------------------------------------------------------------------------------------

Bonne continuation.