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