Vba excel : lire un fichier texte indépendamment de son encodage ansi ou utf-8 (via ado.filestream)

Soyez le premier à donner votre avis sur cette source.

Vue 14 680 fois - Téléchargée 920 fois

Description

Ajout de nouvelles méthodes et fonctions à EXCEL afin de lire les fichiers texte sans se préoccuper de leur encodage.
Cette nouvelle version traite les fichiers via FileStream plus rapidement que la version précédente.
Elle comporte aussi de nouvelles fonctions et méthodes(Encode, Decode, LineInput_UTF8_ANSI)

ANSI est la codification ASCII Europe occidentale de Windows (norme ISO-8859-1)
UTF-8 est la codification Unicode stockée sur un nombre d'octets variables (de 1 a 4).

Il est déjà désagréable de voir son texte avec les caractères spéciaux ou accentués transformés en hiéroglyphes, mais quand il s'agit d'un fichier texte non délimité c'est carrément l'horreur. L'enregistrement qui devrait avoir une longueur fixe devient de longueur variable à cause de la codification UTF-8 qui codifie chaque caractère sur 1 a 4 octets.

Quand on ne maitrise pas le génération du fichier à lire et que l' utilisateur a le choix entre plusieurs types d'encodage il y a des chances pour que ce soit l'encodage par défaut qui soit pris et ce n'est pas forcement ANSI Windows Europe qui est traité nativement par VBA.

Ces nouvelles fonctions permettent de trouver l'encodage du fichier lu et de le traiter en conséquence sans modifier le programme
que le fichier soit fixe ou variable, encodé ANSI ou UTF-8.

Module UTF8_ANSI_FileStream

Ce module utilise le contrôle ActiveX ADODB.Stream.
Pour compiler dans le menu VBA : Outils / Références
il faut cocher la dernière version de "Microsoft ActiveX DataObjects library"

FindEncodage$(FileName$) : Fonction qui détermine et retourne l'encodage pour ActivexDataObject.stream

FindEncodageOrigin$(File Name$) : Fonction qui détermine et retourne l'encodage
pour le paramètre Origin de Workbooks.OpenText

FSopen : Ouvre un File Stream sur le fichier indiqué (encodé ANSI ou UTF8)
Si on laisse FSopen déterminer l'encodage du fichier en entrée
la programmation reste identique que le fichier soit ANSI ou UTF8

FSlineInput : Fonction qui retourne un enregistrement lu dans le Stream ouvert

FSclose : Ferme le File Stream du fichier

Module UTF8_ANSI_EXCEL

LoadFileIntoSheet : Charge un fichier complet (encodé ANSI ou UTF8) dans la feuille demandée
en utilisant la méthode Excel Workbooks.OpenText
(adapter FieldInfo à la structure du fichier)

LoadActivesheetWithFileStream : Charge un fichier complet (encodé ANSI ou UTF8)
dans la colonne "A" de la feuille active
en utilisant la méthode LoadFromFile de la Microsoft ActiveX DataObjects library

Module UTF8_ANSI_VBA
Ce module n'utilise pas FileStream il n'a pas besoin de "Microsoft ActiveX DataObjects library"

Decode : Décodage d'une chaine de caractères UTF-8 en ASCII

Encode : Encodage d'une chaine de caractères ASCII en UTF-8

LineInput_UTF8_ANSI : idem LineInput classique mais décodant automatiquement l' UTF-8 en ASCII

Source / Exemple :


' ------------------------------------------------------------
' Module UTF8_ANSI utilisant ADODB.FileStream (Pour VB et VBA)
' ------------------------------------------------------------

' ***********************************************************************************
' Lecture de fichiers texte en VBA quelque soit leur encodage (ASCII ou UTF-8)
' par BILLOT Michel 20120520
'                   20121122 Optimisation de FindEncodage
' ***********************************************************************************

' Pour connaitre l'encodage d'un fichier, l'ouvrir avec NotePad.exe et faire enregistrer sous
' Si on enregistre un fichier avec NotePad.exe au format UTF-8, le BOM (Byte Order Marker) est écrit au début du fichier

' Le delimiteur d'enregistrement doit etre CRLF standard windows, (Pas Unix, Pas Mac)

' Ce module nécessite le controle "Microsoft ActiveX DataObjects 2.8 library".
'    pour utiliser ses methodes de décodage baptisées FileStream
' Dans le menu VBA : Outils / References
'    Cocher la derniere version de "Microsoft ActiveX DataObjects 2.x library"

' Les types d'encodage traités par les methodes ADODB sont
' ADOstream.Charset = "UTF-8"        ' UNICODE UTF8 (1 char = 1-4 octets)
'                     "iso-8859-1"   ' ASCII   ANSI (1 char = 1   octet)
' Presence ou non d'un BOM (Byte Order Marker) en début de fichier (généré par Notepad.exe).

' Nouvelles routines et fonctions apportées par ce module FileStream :
'
'    LoadFileIntoSheetWithOpenText   : Charge un fichier complet (encodé ANSI ou UTF8) dans la feuille demandée
'                                      En utilisant la méthode Excel Workbooks.OpenText (adapter FieldInfo à la structure du fichier)
'
'    LoadActivesheetWithFileStream   : Charge un fichier complet (encodé ANSI ou UTF8) dans la colonne "A" de la feuille active
'                                      En utilisant la methode LoadFromFile de la Microsoft ActiveX DataObjects library
'
'    FindEncodage$(FileName$,[nLimit]): Fonction qui détermine et retourne l'encodage pour ActivexDataObject.stream
'                                      nLimit est optionnel par défaut seuls les 3 premiers mégas du fichier seront analysés pour déterminer l'encodage.
'
'    FindEncodageOrigin$(FileName$)  : Fonction qui détermine et retourne l'encodage pour le parametre Origin de Workbooks.OpenText

'    =======================================================
'    Traitement classique ligne a ligne avec API FileStream
'    =======================================================
'    Pour compiler ADODB.Stream il faut dans le menu VBA : Outils / References
'    cocher la derniere version de "Microsoft ActiveX DataObjects library"
'
'    FSopen                          : Ouvre un FileStream sur le fichier indiqué (encodé ANSI ou UTF8)
'                                         Si on laisse FSopen déterminer l'encodage du fichier en entree
'                                         la programmation reste identique que le fichier soit ANSI ou UTF8
'
'    FSlineInput                     : Fonction qui retourne un enregistrement lu dans le FileStream ouvert
'
'    FSclose                         : Ferme le FileStream du fichier
'
'
' =============================================================================================
'   ' ----
'   ' TEST
'   ' ----
'
'   ' Chargement fichier UTF8 complet dans feuille active avec la methode ADOstream.LoadFromFile
'   Worksheets("UTF8").Activate
'   LoadActiveSheetWithFileStream ThisWorkbook.Path & "\Texte UTF8 with BOM.txt"
'
'   ' Chargement fichier ANSI complet dans feuille active avec la methode ADOstream.LoadFromFile
'   Worksheets("ANSI").Activate
'   LoadActiveSheetWithFileStream ThisWorkbook.Path & "\Texte ANSI.txt"
'
'
'   ' Chargement fichier complet ANSI dans la feuille demandée avec la methode Workbooks.OpenText
'   LoadFileIntoSheet ThisWorkbook.Path & "\Texte ANSI.txt", "MySheetANSI"
'
'   ' Chargement fichier complet UTF8 dans la feuille demandée avec la methode Workbooks.OpenText
'   LoadFileIntoSheet ThisWorkbook.Path & "\Texte UTF8 with BOM.txt", "MySheetUTF8"
'
'
'   ' --------------------------------------------------------------------------------------------------------------------
'   ' Exemple d'utilisation du FileStream : Lecture sequentielle d'un fichier texte
'   ' Similaire au VBA classique mais en utilisant FileStream pour decoder les enregistrements selon l'encodage du fichier
'   ' Le programme reste identique quelque soit l'encodage si on laisse FSopen determiner automatiquement l'encodage du fichier
'   ' ----------------------------------------------------------|---------------------------------------------------------
'   ' Classique pour fichiers ASCII (ANSI EOM)                  | FileStream pour fichier ASCII (ANSI EOM) UNICODE (UTF-8)
'   ' ----------------------------------------------------------|---------------------------------------------------------
'   ' Dim Rec$                                                  ' Dim Rec$, EOS%
'   '                                                           ' Dim ADOstream As ADODB.Stream
'   ' Open "c:\tmp\Nouveau Document texte.txt" For Input As #1  ' FSopen ADOstream, ThisWorkbook.Path & "\Texte UTF8.txt" , EOS%
'   ' While Not EOF(1)                                          ' While Not EOS%
'   '    Line Input #1, Rec$                                    '    Rec$ = FSlineInput$(ADOstream, EOS%)
'   '    Debug.Print Rec$                                       '    Debug.Print Rec$
'   ' Wend                                                      ' Wend
'   ' Close #1                                                  ' FSclose ADOstream
'   ' ----------------------------------------------------------|---------------------------------------------------------
'
'
'   ' lecture ligne a ligne fichier UTF8 (Seul le nom du fichier change)
'   Dim Rec$, EOS%
'   ' Pour compiler ADODB.Stream faire dans le menu VBA : Outils / References  il faut cocher la derniere version de "Microsoft ActiveX DataObjects library"
'   Dim ADOstream As ADODB.Stream
'   FSopen ADOstream, ThisWorkbook.Path & "\Texte UTF8 with BOM.txt", EOS%
'   While Not EOS%
'      Rec$ = FSlineInput$(ADOstream, EOS%)
'      Debug.Print Rec$
'   Wend
'   FSclose ADOstream
'
'   ' lecture ligne a ligne fichier ANSI (Seul le nom du fichier change)
'   'Dim Rec$, EOS%
'   ' Pour compiler ADODB.Stream faire dans le menu VBA : Outils / References  il faut cocher la derniere version de "Microsoft ActiveX DataObjects library"
'   'Dim ADOstream As ADODB.Stream
'   FSopen ADOstream, ThisWorkbook.Path & "\Texte ANSI.txt", EOS%
'   While Not EOS%
'      Rec$ = FSlineInput$(ADOstream, EOS%)
'      Debug.Print Rec$
'   Wend
'   FSclose ADOstream
'
' =============================================================================================

Option Explicit

Global Const FS_EncodageANSI$ = "iso-8859-1"
Global Const FS_EncodageUTF8$ = "UTF-8"

Global Const ANSI_Coding% = -1   ' La chaine de caracteres est encodée en ANSI
Global Const IDEM_Coding% = 0    ' La chaine de caracteres est identique en ANSI et en UTF-8
Global Const UTF8_Coding% = 1    ' La chaine de caracteres est encodée en UTF-8
   
' ATTENTION si plusieurs fileStream en parallele il faudra modifier
'              pour passer en parametre l'adresse du buffer de chaque fichier.
Global g_NextBuf$   ' Partie de Buffer FileStream non encore exploitée par FSlineInput

Function FindEncodage$(FileName$, Optional NbOctetsLimit&, Optional log$)
   ' par BILLOT Michel 20120520
   ' Détermine si l'encodage du fichier est UTF-8 (UNICODE mondial de longueur variable)
   '                                    ou  ANSI  (ASCII   local   de longueur fixe 1 octet)
   ' BILLOT Michel 20121122 Optimisation :
   '        au maximum 2 secondes pour examiner 3 millons d'octets sans en trouver un ayant un code > 127
   '        instantané si fichier UTF-8 avec BOM
   '        tres rapide s'il y a des caracteres spéciaux ou accentués (codes > 127) dans le fichier
   '        Pour ne pas avoir a examiner l'ensemble d'un tres gros fichier ne comportant que des codes ASCII < 127
   '        vous pouvez passer le parametre NbOctetsLimit& afin de limiter le nb d'octets a examiner.
   '        par défaut tout le fichier est examiné jusqu'a ce que l'on rencontre un caractere > 127
   '        Si NbOctetsLimit& est atteint avant la fin de fichier on n'a pas de certitude quand a l'encodage du fichier
   '           on considere alors que c'est probablement de l'ANSI
   '           Si le fichier ne comporte que des caracteres < a 127
   '              ANSI ou UTF8 donneront le meme résultat mais le traitement ANSI sera plus rapide
   '           Si le fichier comporte des caracteres > a 127 et que l'on utilise le mauvais encodage
   '              Si fichier ANSI traité en UTF8 on perd des caracteres
   '              Si fichier UTF8 traité en ANSI on a des caracteres parasites
   '        Le parametre optionnel LOG$ permet a l'appelant (s'il le désire) de récupérer le compte rendu de la fonction
   '
   ' ------------------------------------------------------------------------
   ' Retourne l'encodage du fichier pour ActivexDataObject.stream
   '          "UTF-8"         si encodé UTF-8
   '          "iso-8859-1"    si encodé ANSI
   '          ""              si le fichier est vide
   ' Retourne aussi un Log si celui ci est demandé
   ' ------------------------------------------------------------------------
         
   Dim Encodage$
   ' On ne se préoccupe pas de la BOM car cela fera réagir de suite la fonction PositionCharDiscriminant&(string$)
   
   Dim c%, Rec$, NbOctetsRead&, P&
   c% = FreeFile
   Open FileName$ For Input As #c%
      
   If NbOctetsLimit& = 0& Then
      ' Nb de caracteres a examiner au maximum pour déterminer l'encodage
      ' par défaut on examine l'ensemble du fichier
      ' Ce qui peut etre pénalisant pour les tres gros fichiers qui ne contiennent pas de caracteres spéciaux
      NbOctetsLimit& = LOF(c%)
   End If
   
   While Not EOF(c%) And Encodage$ = "" And NbOctetsRead& < NbOctetsLimit&
      Line Input #c%, Rec$
      P& = PositionCharDiscriminant&(Rec$)
      ' -X  ' Au Xeme caractere la chaine de caracteres est encodée en ANSI
      '  0  ' La chaine de caracteres est identique en ANSI et en UTF-8
      ' +X  ' Au Xeme caractere la chaine de caracteres est encodée en UTF-8
      Select Case P&
         Case Is < 0
            NbOctetsRead& = NbOctetsRead& + Abs(P&)
            ' On a trouvé un caractere >127 qui ne respecte pas les regles UTF-8
            ' C'est de l'ANSI, inutile de lire tout le fichier
            Encodage$ = FS_EncodageANSI$
         Case Is = 0
            NbOctetsRead& = NbOctetsRead& + Len(Rec$)
            ' Encodage non encore déterminé, continuer la lecture du fichier
         Case Is > 0
            NbOctetsRead& = NbOctetsRead& + P&
            ' On a trouvé un caractere >127 qui respecte les regles UTF-8
            ' C'est de l'UTF-8, inutile de lire tout le fichier
            Encodage$ = FS_EncodageUTF8$
      End Select
   Wend
   Close #c%
   If Encodage$ = "" Then
      ' Aucun byte supérieur a 127 (&h3F) de trouvé dans la limite du fichier ou du nb d'octets demandés
      Encodage$ = FS_EncodageANSI$
      If NbOctetsRead& < NbOctetsLimit& Then
         ' Tout le fichier ne comporte que de l'ASCII <= 127
         log$ = Encodage$ & " car tout le fichier ne comporte que de l'ASCII <= 127"
      Else
         ' On a atteind la limite NbOctetsLimit&  demandée
         ' On considere que c'est probablement de l'ANSI (la lecture en sera plus rapide, on risque seulement d'avoir des parasites)
         log$ = Encodage$ & " présumé car la limite " & NbOctetsLimit& & " octets examinés a été dépassée."
      End If
   Else
      log$ = Encodage$ & " détécté apres " & NbOctetsRead& & " octets examinés"
   End If
   Debug.Print "FindEncodage " & log$
   
   FindEncodage$ = Encodage$
     
End Function
   
Function FindEncodageOrigin$(FileName$)
   ' Détermine l' encodage du fichier pour le parametre Origin de Workbooks.OpenText
   Const xlUTF8 = 65001
   Dim Encodage$
   Encodage$ = FindEncodage$(FileName$)
   If Encodage$ = FS_EncodageUTF8$ Then
      FindEncodageOrigin$ = xlUTF8
   Else
      FindEncodageOrigin$ = xlWindows
   End If
End Function

Public Function PositionCharDiscriminant&(Rec$)
   ' par BILLOT Michel 20121122
   ' Determine si la chaine de caracteres est encodée en UTF-8 ou en ANSI
   ' Et retourne la position dans la chaine du caractere discriminant
   
   ' Entree Chaine de caracteres a examiner
   ' Sortie -P  ' Au Peme caractere la chaine de caracteres est encodée en ANSI
   '         0  ' La chaine de caracteres est identique en ANSI et en UTF-8
   '        +P  ' Au Xeme caractere la chaine de caracteres est encodée en UTF-8
    
   Dim X&, c1%, c2%, c3%, c4%, wBuf$, wCoding%, P&
   wCoding% = IDEM_Coding%
   
   If Rec$ = "" Then
      ' Enregistrement vide : rien a faire
   Else
      ' Ce n'est pas un enregistrement vide, il faut de Décoder a plein tube
      '
      '      Unicode range      |         UTF-8 1 à 4 octets            |  ASCII (ANSI)
      '      (hexadecimal)      |              (binary)                 | (hexadecimal)
      '   ----------------------+------------------------------------------------------
      '   0000 0000 - 0000 007F | 0aaaaaaa                              |  00 - FF
      '   0000 0080 - 0000 07FF | 110aaaaa 10bbbbbb                     |  00 - FF
      '   0000 0800 - 0000 7FFF | 1110aaaa 10bbbbbb 10cccccc            |  00 - FF
      '   0000 8000 - 001F FFFF | 11110aaa 10bbbbbb 10cccccc 10dddddd   |  00 - FF
      '
      '   Bin  0000 0001 0010 0011 0100 0101 0110 0111 1000 1001 1010 1011 1100 1101 1110 1111
      '   Hex     0    1    2    3    4    5    6    7    8    9    A    B    C    D    E    F
       
      ' Rec$ = Chaine de caracteres a examiner (La BOM ayant été enlevée)
      
      ' ajoute 1 caractere  neutre  (ayant un meme code en ASCII et en UTF-8) pour ne pas avoir à tester le début du buffer
      ' ajoute 3 caracteres neutres (ayant un meme code en ASCII et en UTF-8) pour ne pas avoir à tester la fin   du buffer
      wBuf$ = "." & Rec$ & "..."
      X& = 2
      ' Boucle avec condition de fin recalculée alors que For a une condition de fin figée au départ
      While X& < Len(wBuf$) - 3 And wCoding% = IDEM_Coding%
         c1% = Asc(Mid$(wBuf$, X&, 1))
         'Debug.Print X& & " Caractere " & Chr$(c1%) & " " & Hex$(c1%)
         If (c1% And &H80) = 0 Then
            ' 0xxx xxxx
            ' Pas de bit 8 -> Chr(1-127) -> codes ANSI et UTF8 égaux sur 1 octet.
         Else
            ' 1xxx xxxx
            If (c1% And &HE0) = &HC0 Then
               ' 110x xxxx
               c2% = Asc(Mid$(wBuf$, X& + 1, 1))
               If (c2% And &HC0) = &H80 Then
                  ' Codif UTF8 sur 2 octets
                  ' 110a aaaa 10bb bbbb
                  wCoding% = UTF8_Coding%
                  P& = X& - 1 ' - . du début
               Else
                  ' Ce n'est pas de l'UTF8
                  ' 110x xxxx
                  wCoding% = ANSI_Coding%
                  P& = X& - 1 ' - . du début
               End If
          
            Else
               If (c1% And &HF0) = &HE0 Then
                  ' 1110 xxxx
                  ' Peut etre le debut d'un UTF8
                  c2% = Asc(Mid$(wBuf$, X& + 1, 1))
                  c3% = Asc(Mid$(wBuf$, X& + 2, 1))
                  If (c2% And &HC0) = &H80 _
                  And (c3% And &HC0) = &H80 Then
                     ' Codif UTF8 sur 3 octets
                     ' 1110 aaaa 10bb bbbb 10cc cccc
                     wCoding% = UTF8_Coding%
                     P& = X& - 1 ' - . du début
                  Else
                     ' Ce n'est pas de l'UTF8
                     ' 1110 xxxx
                     wCoding% = ANSI_Coding%
                     P& = X& - 1 ' - . du début
                  End If
          
               Else
                  If (c1% And &HF8) = &HF0 Then
                     ' 1111 0xxx
                     c2% = Asc(Mid$(wBuf$, X& + 1, 1))
                     c3% = Asc(Mid$(wBuf$, X& + 2, 1))
                     c4% = Asc(Mid$(wBuf$, X& + 3, 1))
                     If (c2% And &HC0) = &H80 _
                     And (c3% And &HC0) = &H80 _
                     And (c4% And &HC0) = &H80 Then
                        ' Codif UTF8 sur 4 octets
                        ' 1111 0aaa 10bb bbbb 10cc cccc 10dd dddd
                        wCoding% = UTF8_Coding%
                        P& = X& - 1 ' - . du début
                     Else
                        ' Ce n'est pas de l'UTF8
                        ' 1111 0xxx
                        wCoding% = ANSI_Coding%
                        P& = X& - 1 ' - . du début
                     End If
                  Else
                     ' 1xxx xxxx
                     ' Code > 127 mais non UTF-8
                     wCoding% = ANSI_Coding%
                     P& = X& - 1 ' - . du début
                  End If
               End If
            End If
         End If
      
         X& = X& + 1   'Next X&   ' caractere suivant dans la chaine
      Wend
   End If
   
   ' retourne le type de codage rencontré dans la chaine passée en parametre
   ' Ainsi que la position du caractere discriminant s'il existe
   ' P& = Position du caractere discriminant ou 0 si pas de discrimination.
   ' wCoding% = ANSI_Coding% = -1   ' La chaine de caracteres est encodée en ANSI
   ' wCoding% = IDEM_Coding% = 0    ' La chaine de caracteres est identique en ANSI et en UTF-8
   ' wCoding% = UTF8_Coding% = 1    ' La chaine de caracteres est encodée en UTF-8
   PositionCharDiscriminant& = P& * wCoding%

End Function

Function FSlineInput$(ADOstream, EOS%, Optional Reset$)
   ' ----------------------------------------------------------
   ' Lecture d'un fichier texte UTF-8 ou ASCII
   ' par BILLOT Michel 20120520
   '     optimisation  20121212
   '
   ' ADOstream.Charset = "UTF-8"
   '                     "iso-8859-1"
   '                     "ASCII"   si dérivation vers FileSystem classique
   '
   ' Le delimiteur d'enregistrement est CRLF (standard windows)
   ' ----------------------------------------------------------

   ' Cette fonction VBA utilise le controle "Microsoft ActiveX DataObjects 2.8 library".
   ' Dans le menu VBA : Outils / References
   '          Cocher la derniere version de "Microsoft ActiveX DataObjects library"

   ' Entrée : Le fichier a traiter doit etre ouvert sur l'objet ADOstream
   '         avec ADOstream.Charset = "UTF-8" ' "ASCII"  "iso-8859-1"   "us-ascii",
   '   ADOstream.Charset  : "UTF-8"        si le fichier est encodé en UTF-8 (Précisé en entrée ou determiné automatiquement)
   '                      : "iso-8859-1"   si le fichier est encodé en ANSI  (Précisé en entrée)
   '                      : "ASCII"        si le fichier est encodé en ANSI  (determiné automatiquement par FSopen)
   '                      :                   dérivation pour traiter plus rapidement ce fichier en utilisant le FileSystem classique
   '   ADOstream.Mode     : N° de canal sur lequel est ouvert le fichier (si ASCII classique déterminé par FSopen)
   '
   '   g_NextBuf$         : Partie de Buffer FileStream non encore exploitée
   '
   ' Sortie : retourne un enregistrement idem LineInput #x, Rec$
   '   EOS%          est positionné avec le dernier enregistrement du fichier
   '   ADOstream.EOS est positionné avec le dernier buffer du fichier qui peut contenir plusieurs enregistrements
   '   g_NextBuf$    Partie de Buffer FileStream non encore exploitée apres extraction de l'enregistrement.
   
   Dim Rec$, P&, wBuf$
   Const BUFLEN = 2048 ' Meilleures performances 2048 '1024 '2048  '4096  '8192 '16192

   If ADOstream.Charset = "ASCII" Then
      ' ----------------------------------------------------------------------------
      ' Dérivation vers le FileSystem classique (Plus rapide pour traiter de l'ANSI)
      ' ----------------------------------------------------------------------------
      Dim c%
      c% = ADOstream.Mode
      Line Input #c%, Rec$
      FSlineInput$ = Rec$
      If EOF(c%) Then
         EOS% = True
      End If
   Else
      ' ----------------------------------------------------------------------------
      ' Utilisation normale du FileStream
      ' ----------------------------------------------------------------------------
      ' Init Record
      Rec$ = ""
   
      Do
         If g_NextBuf$ > "" Then
            ' Reliquat du buffer précédent
            wBuf$ = g_NextBuf$
            g_NextBuf$ = ""
            'Debug.Print "Old buf="; WBuf$
         Else
            ' Alimente un nouveau buffer a partir du fichier
            ' en tenant compte du type d'encodage
            wBuf$ = ADOstream.ReadText(BUFLEN)
            'Debug.Print "New buf="; WBuf$
         End If
         
         P& = InStr(wBuf$, Chr$(10))
         If P& = 0 Then
            ' Pas de LF, on prend tout et on continue
            Rec$ = Rec$ & wBuf$
         Else
            ' LF Localisé dans le buffer on complete l'enregistrement
            Rec$ = Rec$ & Left$(wBuf$, P&)
            ' On preserve la suite du Buffer pour le prochain appel
            g_NextBuf$ = Mid$(wBuf$, P& + 1)
            If Right$(Rec$, 2) = vbCrLf Then
               ' record windows ready on enleve CRLF
               FSlineInput$ = Left$(Rec$, Len(Rec$) - 2)
            Else
               ' record unix ready on enleve LF
               FSlineInput$ = Left$(Rec$, Len(Rec$) - 1)
            End If
            ' EOS ?
            If g_NextBuf$ = "" And ADOstream.EOS Then
               ' C'est le dernier enregistrement du dernier bloc
               EOS% = True
            End If
            Exit Function
         End If
      Loop
   End If
End Function

Sub FSopen(ADOstream, FileName$, EOS%, Optional Encodage$)
   ' -------------------------------------------------------------------------------------------------------
   ' Ouvre un fichier en utilisant le streamer du controle Activex DataObject
   ' afin de pouvoir traiter de la meme maniere les fichiers encodés en UTF8 ou ANSI
   ' par BILLOT Michel 20120520
   '     optimisation  20121212 Pour les fichiers UTF8 on utilise FileStream
   '                                              ANSI on utilise le systeme de fichier classique car il est plus rapide
   '
   ' Si l'encodage n'est pas spécifié, FSopen va determiner s'il s'agit de UTF-8 ou ISO-8859-1
   ' Ce qui prend un peu de temps si le fichier est un gros UTF-8
   ' car il est entierement lu pour verifier son encodage UTF-8 (seuls les caracteres ASCII > 127 different)
   ' -------------------------------------------------------------------------------------------------------
   ' Entrées :
   '   ADOstream  Objet de DAO activeX library
   '   FileName$  Nom du fichier a traiter (avec ou sans path)
   '   Encodage$  "UTF-8"        si vous savez que le fichier est encodé en UTF-8
   '              "iso-8859-1"   si vous savez que le fichier est encodé en ANSI
   '              ""             si FSopen doit déterminer l'encodage
   '
   ' Sorties :
   '   ADOstream.Charset  : "UTF-8"        si le fichier est encodé en UTF-8 (Précisé en entrée ou determiné automatiquement)
   '                      : "iso-8859-1"   si le fichier est encodé en ANSI  (Précisé en entrée)
   '                      : "ASCII"        si le fichier est encodé en ANSI  (determiné automatiquement par FSopen)
   '                      :                   dérivation pour traiter plus rapidement ce fichier en utilisant le FileSystem classique
   '   ADOstream.Mode     : N° de canal sur lequel est ouvert le fichier (si ASCII classique déterminé par FSopen)
   '   ADOstream.EOS      : True si le fichier est vide (ADOstream.EOS  indique le dernier buffer
   '   EOS%               : True si le fichier est vide (          EOS% indique le dernier record)
   
   ' Teste si fichier vide
   Dim c%
   c% = FreeFile
   Open FileName For Input As #c%
   If LOF(c%) = 0 Then
      EOS% = True
   Else
      EOS% = False
   End If
   Close c%
      
   ' Détermine l'encodage
   If Encodage$ = "" Then
      ' Encodage non spécifié, FSopen doit le déterminer
      Encodage$ = FindEncodage$(FileName$)
      If Encodage$ = "iso-8859-1" Then
         ' Le fichier est encodé ANSI
         ' Comme il est plus rapide de le traiter avec le filssystem classique
         ' On greffe une dérivation sur le FileStream
         Encodage$ = "ASCII"
      End If
   End If
   
   ' Initialise la structure FileStream passée en parametre(pour utilisation normale ou dérivation)
   'Dim ADOstream As ADODB.Stream
   Set ADOstream = New ADODB.Stream
   ADOstream.Charset = Encodage$       ' Stocke l'encodage ou l'identifiant dérivation ASCII dans la propriété Charset
   If Encodage$ = "ASCII" Then
      ' Dérivation vers FileSystem classique
      Open FileName$ For Input As #c%
      ADOstream.Mode = c%               ' Stocke le N° du canal de dérivation dans la propriété Mode
   Else
      ' FileStream standard
      ADOstream.Open
      ADOstream.LoadFromFile FileName$
      ' Si le fichier   est     vide  ADOstream.EOS est a True
      ' Si le fichier n'est pas vide  ADOstream.EOS est a False
   End If
   
End Sub

Sub FSclose(ADOstream)
   If Not ADOstream Is Nothing Then
      ' Fermeture d'un FileStream reellement ouvert
      If ADOstream.Charset = "ASCII" Then
         ' ----------------------------------------------------------------------------
         ' Dérivation vers le FileSystem classique (Plus rapide pour traiter de l'ANSI)
         ' ----------------------------------------------------------------------------
         Dim c%
         c% = ADOstream.Mode
         Close #c%
      Else
         ' ----------------------------------------------------------------------------
         ' Utilisation normale du FileStream
         ' ----------------------------------------------------------------------------
         ADOstream.Close
         Set ADOstream = Nothing
      End If
      ' Fin d'utilisation de l'objet FileStream
      Set ADOstream = Nothing
      g_NextBuf$ = ""  ' Au cas ou on s'arrete avant la fin de fichier vide le buffer pour ne pas perturber l'éventuel FileStream suivant.
   End If
End Sub

' ----------------------------------------------------------------------------------------
' Module UTF8_ANSI 100% VB ou VBA (Sans ADODB.FileStream et sans Application.LoadTextFile)
' Une autre facon de traiter les fichiers texte quelque soit leur encodage
'
' La facon la plus simple de traiter les fichiers indépendamment de leur encodage
' Il suffit d'incorporer ce module UTF8_ANSI_VBA dans le projet
' et dans le programme et de remplacer
'    Line Input         #Canal%, Rec$
' par
'    LineInput_UTF8_ANSI Canal%, Rec$
'
' La routine LineInput_UTF8_ANSI est plus rapide que le FSlineInput pour les fichiers ANSI
' Mais elle est plus lente pour les fichiers UTF-8
' Pour les petits fichiers la différence de temps de traitement est négligeable.
'                          ---------------|----------------------
'                          ADO.FileStream |         VB VBA
'                           FSlineInput   |   LineInput_UTF8_ANSI
'                          ---------------|----------------------
' FICHIER ANSI   10 mégas       1 sec     |        1 sec
'                                         |
' FICHIER UTF-8  10 mégas       2 sec     |        4 sec
'
' FICHIER ANSI   50 mégas       4 sec     |        3 sec
'                                         |
' FICHIER UTF-8  50 mégas       7 sec     |       23 sec
'
' FICHIER ANSI  200 mégas      22 sec     |       16 sec
'                                         |
' FICHIER UTF-8 200 mégas      31 sec     |       93 sec
'
' FICHIER ANSI  300 mégas      34 sec     |       17 sec
'                                         |
' FICHIER UTF-8 300 mégas      59 sec     |      140 sec
'
' ----------------------------------------------------------------------------------------

'   ============================================================
'   Traitement classique ligne a ligne avec uniquement VB ou VBA
'   ============================================================
'   En remplacement du standard : Line Input #Canal%,Rec$
'   sans avoir a s'occuper de l'encodage du fichier :
'
'   LineInput_UTF8_ANSI Canal%, Rec$
'
'   Et en cadeau BONUS
'   si on n'a que des chaines de caracteres à trancoder il y a les fonctions :
'
'   EncodeUTF8$ (StringANSI$)
'
'   DecodeUTF8$ (StringUTF8$)

Option Explicit

Global Const ANSI = "ANSI"
Global Const UTF8 = "UTF-8"

' Pour les fichiers ouverts sur les canaux 1 à 10
Global g_t_BOM$(10)       ' Presence ou non d'un BOM (Byte Order Marker) en début de fichier.
                          ' The UTF-8 representation of the BOM is the byte sequence &hEF,&hBB,&hBF -> ""
Global g_t_Encodage$(10)  ' Encodage des fichiers ouverts sur les canaux 1-10

Sub LineInput_UTF8_ANSI(Canal%, Rec$)
   ' -------------------------------------------------------------------------------------------
   ' par BILLOT Michel 20121212
   ' Lecture d'une ligne dans un fichier texte encodé UTF-8 ou ANSI
   ' Idem LINE INPUT mais s'adapte automatiquement à l'encodage du fichier
   '
   ' Pour les petits fichiers cette routine est équivalente à FileStream
   '
   ' Pour les gros fichiers de plus de 50 mégas encodés en UTF-8
   '    Cette routine 100% VBA est moins rapide que les API de ADODB.FileStream
   '    car le décodage en VBA est plus lent que le décodage en assembleur
   ' Pour les gros fichiers de plus de 50 mégas encodés en ANSI et ayant des caracteres > 127
   '    Cette routine 100% VBA est plus rapide que l' API de ADODB.FileStream
   '    car elle est intelligente et réagit dès qu'elle détecte que c'est de l'ANSI
   ' -------------------------------------------------------------------------------------------
   '
   ' Syntaxe :
   '    LineInput_UTF8_ANSI Canal%, Rec$
   ' ou
   '    Call LineInput_UTF8_ANSI(Canal%, Rec$)
   '
   ' Entrées :
   '    Canal%          : N° de canal sur lequel le fichier est ouvert en input
   '    g_t_BOM$(Canal%): BOM dans le fichier ouvert sur le canal%
   '         = ""       : BOM a détecter par LineInput_UTF8_ANSI (Valeur par défaut pour le premier fichier ouvert sur ce canal)
   '         = "Y"      : La BOM a été trouvée au début du fichier
   '         = "N"      : La BOM n'a pas été trouvée au début du fichier
   '    g_t_Encodage$(Canal%) : Encodage du fichier ouvert sur le canal%
   '         = ""       : Encodage indéterminé à déterminer par LineInput_UTF8_ANSI (Valeur par défaut pour le premier fichier ouvert sur ce canal)
   '         = "ANSI"   : Encodage forcé ou déja déterminé par LineInput_UTF8_ANSI
   '         = "UTF-8"  : Encodage forcé ou déja déterminé par LineInput_UTF8_ANSI
   ' Sorties
   '    Rec$            : Chaine de caracteres lue encodée en ANSI
   '    EOF(Canal%)     : si la fin de fichier est atteinte
   '    g_t_BOM$(Canal%): BOM dans le fichier ouvert sur le canal
   '         = "Y"      : La BOM   a     été trouvée au début du fichier
   '         = "N"      : La BOM n'a pas été trouvée au début du fichier
   '    g_t_Encodage$(Canal%) : Encodage du fichier ouvert sur le canal
   '         = ""       : Encodage non encore déterminé par LineInput_UTF8_ANSI
   '         = "ANSI"   : Encodage déterminé ANSI  pour ce fichier
   '         = "UTF-8"  : Encodage déterminé UTF-8 pour ce fichier
   
   ' Exemple d'utilisation :
   '    ' Le premiere fois que l'on ouvre un fichier sur un canal
   '         Il n'est pas nécessaire d'initialiser g_t_BOM$ et g_t_Encodage$ (les valeurs par défaut sont "")
   '    ' mais si on ouvre successivement plusieurs fichier sur le meme canal c'est nécessaire
   '    ' aussi c'est une bonne habitude aprendre d'initialiser ces variables avant l'ouvertre du fichier.
   '    g_t_BOM$(1)= ""        ' LineInput_UTF8_ANSI doit déterminer s'il y a une BOM ou non sur le canal%
   '    g_t_Encodage$(1) = ""  ' LineInput_UTF8_ANSI doit déterminer l'encodage du fichier ouvert sur le canal%
   '    OPEN #1,"MonFichierUTF8ouANSI" For Input As #1
   '    While not EOF(1)
   '       LineInput_UTF8_ANSI 1, Rec$
   '       Debug.Print Rec$
   '    Wend
   '    Close #1
   '    Debug.Print "Le fichier ouvert sur le canal 1 était encodé en " & g_t_Encodage$(1)
   
   
   Line Input #Canal%, Rec$
   
   If g_t_BOM$(Canal%) = "" Then
      ' Premiere fois, on détermine s'il y a une BOM
      If Left$(Rec$, 3) = "" Then
         ' Il y a une BOM UTF-8
         '   Hex       | ANSI
         '   EF BB BF  | 
         g_t_BOM$(Canal%) = "Y"
         g_t_Encodage$(Canal%) = UTF8     ' On force l' encodage UFT-8
         Rec$ = Mid$(Rec$, 4)                ' on enleve la BOM de l'enregistrement
      Else
         ' Pas de BOM
         g_t_BOM$(Canal%) = "N"
         ' On laisse g_t_Encodage$(Canal%) a sa valeur initiale au cas ou on aurait voulu le forcer
      End If
   End If
   
   Select Case g_t_Encodage$(Canal%)
      Case Is = "", UTF8
         Rec$ = DecodeUTF8$(Rec$, g_t_Encodage$(Canal%))
         
      Case Is = ANSI
         ' pas besoin de Decoder Rec$ reste inchangé
         
      Case Else
         MsgBox ("g_t_Encodage$(" & Canal% & ") " & g_t_Encodage$(Canal%) & " imprévu")
         End  ' aboboXL
         
   End Select
   
End Sub

Function DecodeUTF8$(Rec$, Optional Encodage$)
   ' Cette fonction retourne la chaine de caracteres UTF8 décodée en ANSI
   ' BILLOT Michel 20121212
   
   ' Entrées       :
   '   Rec$        : Chaine de caracteres UTF-8 a décoder (Le BOM est a gérer a l'extérieur de cette fonction)
   '   Encodage$   : Optionelle si on désire recupérer le type d'encodage rencontré dans cette chaine
   ' Sorties       :
   '   DecodeUTF8$ : Chaine de caracteres ANSI  décodée
   '   Encodage$   : Encodage détecté dans cette chaine
      
   Dim X&, c1%, c2%, c3%, c4%, wBuf$, Unicode&
   
   If Rec$ = "" Then
      ' Enregistrement vide : rien a faire
      wBuf$ = ""
   Else
      ' Ce n'est pas un enregistrement vide, il faut de Décoder a plein tube
      '
      '      Unicode range      |         UTF-8 1 à 4 octets            |  ASCII (ANSI)
      '      (hexadecimal)      |              (binary)                 | (hexadecimal)
      '   ----------------------+------------------------------------------------------
      '   0000 0000 - 0000 007F | 0aaaaaaa                              |  00 - FF
      '   0000 0080 - 0000 07FF | 110aaaaa 10bbbbbb                     |  00 - FF
      '   0000 0800 - 0000 7FFF | 1110aaaa 10bbbbbb 10cccccc            |  00 - FF
      '   0000 8000 - 001F FFFF | 11110aaa 10bbbbbb 10cccccc 10dddddd   |  00 - FF
      '
      '   Bin  0000 0001 0010 0011 0100 0101 0110 0111 1000 1001 1010 1011 1100 1101 1110 1111
      '   Hex     0    1    2    3    4    5    6    7    8    9    A    B    C    D    E    F
       
      ' Rec$ = Chaine de caracteres a examiner (La BOM ayant été enlevée)
      
      ' ajoute 1 caractere  neutre  (ayant un meme code en ASCII et en UTF-8) pour ne pas avoir à tester le début du buffer
      ' ajoute 3 caracteres neutres (ayant un meme code en ASCII et en UTF-8) pour ne pas avoir à tester la fin   du buffer
      wBuf$ = "." & Rec$ & "..."
      X& = 2
      ' Boucle avec condition de fin recalculée alors que For a une condition de fin figée au départ
      While X& < Len(wBuf$) - 3
         c1% = Asc(Mid(wBuf$, X&, 1))
         'Debug.Print X& & " Caractere " & Chr$(c1%) & " " & Hex$(c1%)
         If (c1% And &H80) = 0 Then
            ' 0xxx xxxx
            ' Pas de bit 8 -> Chr(1-127) -> Codif ASCII = UTF8 sur 1 octet.
            ' octet suivant au Next
         Else
            ' 1xxx xxxx
            If (c1% And &HE0) = &HC0 Then
               ' 110x xxxx
               c2% = Asc(Mid(wBuf$, X& + 1, 1))
               If (c2% And &HC0) = &H80 Then
                  ' Codif UTF8 sur 2 octets
                  ' 110a aaaa 10bb bbbb  ->  0000 0aaa aabb bbbb  ' UTF-8(2) --> UNICODE
                  ' 1110 0000 1100 0000                           ' bin mask identification UTF8
                  '    E    0    C    0                           ' hex mask identification UTF8
                  '    C    0    8    0                           ' hex codif longueur caractere utf8
                  '    1    F    3    F                           ' mask selection bits Codif Unicode
                  '         x                           4      0  ' cadrage c1
                  '                   x                        1  ' cadrage c2
                  Unicode& = (c1% And &H1F) * &H40 _
                           + (c2% And &H3F)
                  wBuf$ = Left$(wBuf$, X& - 1) & ChrW$(Unicode&) & Mid$(wBuf$, X& + 2)
                  ' octet suivant le caractere remplacé au Next
               Else
                  ' Ce n'est pas de l'UTF8
                  ' 110x xxxx
                  ' encodage ANSI pour les enregistrements suivants
                  Encodage$ = ANSI
                  ' octet suivant au Next
               End If
          
            Else
               If (c1% And &HF0) = &HE0 Then
                  ' 1110 xxxx
                  ' Peut etre le debut d'un UTF8
                  c2% = Asc(Mid(wBuf$, X& + 1, 1))
                  c3% = Asc(Mid(wBuf$, X& + 2, 1))
                  If (c2% And &HC0) = &H80 _
                  And (c3% And &HC0) = &H80 Then
                     ' Codif UTF8 sur 3 octets
                     ' 1110 aaaa 10bb bbbb 10cc cccc ->  0000 aaaa bbbb bbcc cccc  ' UTF-8(3) --> UNICODE
                     ' 1111 0000 1100 0000 1100 0000                               ' bin mask identification UTF8
                     '    F    0    C    0    C    0                               ' hex mask identification UTF8
                     '    E    0    8    0    8    0                               ' hex codif longueur caractere utf8
                     '    0    F    3    F    3    F                               ' mask selection bits Codif Unicode
                     '         x                                 1    0    0    0  ' cadrage c1
                     '                   x                               4      0  ' cadrage c2
                     '                             x                            1  ' cadrage c3
                     Unicode& = (c1% And &HF) * &H1000 _
                              + (c2% And &H3F) * &H40 _
                              + (c3% And &H3F)
                     wBuf$ = Left$(wBuf$, X& - 1) & ChrW$(Unicode&) & Mid$(wBuf$, X& + 3)
                     ' octet suivant le caractere remplacé au Next
                  Else
                     ' Ce n'est pas de l'UTF8
                     ' 1110 xxxx
                     ' encodage ANSI pour les enregistrements suivants
                     Encodage$ = ANSI
                     ' octet suivant au Next
                  End If
          
               Else
                  If (c1% And &HF8) = &HF0 Then
                     ' 1111 0xxx
                     c2% = Asc(Mid(wBuf$, X& + 1, 1))
                     c3% = Asc(Mid(wBuf$, X& + 2, 1))
                     c4% = Asc(Mid(wBuf$, X& + 3, 1))
                     If (c2% And &HC0) = &H80 _
                     And (c3% And &HC0) = &H80 _
                     And (c4% And &HC0) = &H80 Then
                        ' Codif UTF8 sur 4 octets
                        ' 1111 0aaa 10bb bbbb 10cc cccc 10dd dddd ->  000a aabb bbbb cccc ccdd dddd  ' UTF-8(4) --> UNICODE
                        ' 1111 1000 1100 0000 1100 0000 1100 0000                                    ' bin mask identification UTF8
                        '    F    8    C    0    C    0    C    0                                    ' hex mask identification UTF8
                        '    F    0    8    0    8    0    8    0                                    ' hex codif longueur caractere utf8
                        '    0    7    3    F    3    F    3    F                                    ' mask selection bits Codif Unicode
                        '         x                                         4      0    0    0    0  ' cadrage c1
                        '                   x                                      1    0    0    0  ' cadrage c2
                        '                             x                                    4      0  ' cadrage c3
                        '                                       x                                 1  ' cadrage c4
                        Unicode& = (c1% And &H7) * &H40000 _
                                 + (c2% And &H3F) * &H1000 _
                                 + (c3% And &H3F) * &H40 _
                                 + (c4% And &H3F)
                        wBuf$ = Left$(wBuf$, X& - 1) & ChrW$(Unicode&) & Mid$(wBuf$, X& + 4)
                        ' octet suivant le caractere remplacé au Next
                     Else
                        ' Ce n'est pas de l'UTF8
                        ' 1111 0xxx
                        ' encodage ANSI pour les enregistrements suivants
                        Encodage$ = ANSI
                        ' octet suivant au Next
                     End If
                  Else
                     ' 1xxx xxxx
                     ' Code > 127 mais non UTF-8
                     Encodage$ = ANSI
                     ' octet suivant au Next
                  End If
               End If
            End If
         End If
      
         X& = X& + 1   'Next X&   ' caractere suivant dans la chaine corrigée
      Wend
      If Encodage$ = "" Then
         ' L'encodage n'est pas encore déterminé
         If Len(Rec$) <> Len(wBuf$) - 4 Then
             ' encodage UFT-8 pour les enregistrements suivants
            Encodage$ = UTF8
         End If
      End If
      ' Enleve les caracteres neutres ".xxxxxxxxx..."  qui ont évité de tester le début et la fin de chaine a chaque octet
      wBuf$ = Mid$(wBuf$, 2, Len(wBuf$) - 4)
   End If
   
   ' retourne la chaine de caracteres encodée ANSI
   DecodeUTF8$ = wBuf$
   
End Function

Public Function EncodeUTF8$(Rec$)

   ' Cette fonction retourne la chaine de caracteres ANSI encodée en UTF8
   ' BILLOT Michel 20121212
   
   ' Entrées     :
   '   Rec$      : Chaine de caracteres ANSI a encoder en UTF-8
   ' Sorties     :
   '   Rec$      : Chaine de caracteres UTF-8
   
   
   '      Unicode range      |         UTF-8 1 à 4 octets            |  ASCII (ANSI)
   '      (hexadecimal)      |              (binary)                 | (hexadecimal)
   '   ----------------------+------------------------------------------------------
   '   0000 0000 - 0000 007F | 0aaaaaaa                              |  00 - FF
   '   0000 0080 - 0000 07FF | 110aaaaa 10bbbbbb                     |  00 - FF
   '   0000 0800 - 0000 7FFF | 1110aaaa 10bbbbbb 10cccccc            |  00 - FF
   '   0000 8000 - 001F FFFF | 11110aaa 10bbbbbb 10cccccc 10dddddd   |  00 - FF
   '
   '   Bin  0000 0001 0010 0011 0100 0101 0110 0111 1000 1001 1010 1011 1100 1101 1110 1111
   '   Hex     0    1    2    3    4    5    6    7    8    9    A    B    C    D    E    F
   
   
   Dim strUTF8$, X&, Unicode&, Char%
   strUTF8$ = ""
   X& = 1
   While X& <= Len(Rec$)
      ' Converti la caractere ANSI 8 bits en caractere UNICODE 32 bites
      Unicode& = AscW(Mid(Rec$, X&, 1))
      '        UNICODE                                    |  UTF-8
      '        00000000   00000000   00000000   00000000  |  00000000
      '        00000000   00000000   00000000   0aaaaaaa  |  0aaaaaaa
      '        00000000   00000000   00000aaa   aabbbbbb  |  110aaaaa 10bbbbbb
      '        00000000   00000000   aaaabbbb   bbcccccc  |  1110aaaa 10bbbbbb 10cccccc
      '        00000000   000aaabb   bbbbcccc   ccdddddd  |  11110aaa 10bbbbbb 10cccccc 10dddddd
           
      ' Converi le caractere Unicode en chaine de caracteres UTF-8
      If (Unicode& And &HFFFFFF80) = 0 Then
         ' mask  F   F      F   F      F   F      8   0
         ' uChar 00000000   00000000   00000000   0aaaaaaa  ->  0aaaaaaa
         ' UTF-8 sur un octet
         strUTF8$ = strUTF8$ & Chr$(Unicode&)
      Else
         If (Unicode& And &HFFFFF800) = 0 Then
            ' mask  F   F      F   F      F   8      0   0
            ' uchar 00000000   00000000   00000aaa   aabbbbbb  ->  110aaaaa 10bbbbbb
            ' cadra                                   4     0
            ' cadrb                                         0
            ' UTF-8 sur deux octets
            strUTF8$ = strUTF8$ & Chr$((Fix(Unicode& / &H40)) Or &HC0)  ' 110aaaaa
            strUTF8$ = strUTF8$ & Chr$((Unicode& And &H3F) Or &H80)     ' 10bbbbbb
            'Debug.Print Mid(Rec$, X&, 1); " ANSI="; Hex$(Asc(Mid(Rec$, X&, 1))); " Unicode="; Hex$(Unicode&); " UTF8="; Hex$((Fix(Unicode& / &H40)) Or &HC0); " "; Hex$((Unicode& And &H3F) Or &H80)
         Else
            If (Unicode& And &HFFFF0000) = 0 Then
               ' mask  F   F      F   F      0   0      0   0
               ' uchar 00000000   00000000   aaaabbbb   bbcccccc  ->  1110aaaa 10bbbbbb 10cccccc
               ' cadra                          1   0      0   0
               ' cadrb                                   4     0
               ' cadrc                                         0
               ' UTF-8 sur trois octets
               strUTF8$ = strUTF8$ & Chr$((Fix(Unicode& / &H1000)) Or &HE0)           ' 1110aaaa
               strUTF8$ = strUTF8$ & Chr$(((Fix(Unicode& / &H40)) And &H3F) Or &H80)  ' 10bbbbbb
               strUTF8$ = strUTF8$ & Chr$((Unicode& And &H3F) Or &H80)                ' 10cccccc
            Else
               ' (Unicode& And &HFFE00000) = 0 Then
               ' mask  F   F      E   0      0   0      0   0
               ' uchar 00000000   000aaabb   bbbbcccc   ccdddddd  |  11110aaa 10bbbbbb 10cccccc 10dddddd
               ' cadra                 4        0   0      0   0
               ' cadrb                          1   0      0   0
               ' cadrc                                   4     0
               ' cadrd                                         0
               ' UTF-8 sur quatre octets
               strUTF8$ = strUTF8$ & Chr$((Fix(Unicode& / &H40000)) Or &HF0)            ' 11110aaa
               strUTF8$ = strUTF8$ & Chr$(((Fix(Unicode& / &H1000)) And &H3F) Or &H80)  ' 10bbbbbb
               strUTF8$ = strUTF8$ & Chr$(((Fix(Unicode& / &H40)) And &H3F) Or &H80)    ' 10cccccc
               strUTF8$ = strUTF8$ & Chr$((Unicode& And &H3F) Or &H80)                  ' 10dddddd
            End If
         End If
      End If
      X& = X& + 1
   Wend
   
   ' retourne la chaine de caracteres encodée UTF-8
   EncodeUTF8$ = strUTF8$
End Function

Codes Sources

A voir également

Ajouter un commentaire

Commentaire

Un grand merci à toi pour ton code il est juste génial et m'enlève une sacrée épine du pied !!

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.