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
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
| ' Établir la référence à ADODB : Microsoft ActiveX Data Objects 6.1 Library
' Pour les valeurs de Stream.Charset, voir dans le registre : HKEY_CLASSES_ROOT\MIME\Database\Charset
Option Explicit
Option Private Module
Public Const sepV$ = "," 'séparateur de valeurs
Public Const sepL$ = vbCrLf 'séparateur de lignes
Public Const idTxt$ = """" 'identificateur de texte = chr(34)
Private Sub Test()
Dim nom$
nom = ThisWorkbook.Path & "\Fichiers texte\Test_UTF8_avec_BOM.csv" 'à adapter
Call Charger_csv_UTF8_dans_tableau(ActiveSheet, nom)
End Sub
Public Sub Charger_csv_UTF8_dans_tableau(wsh As Worksheet, ByVal nomCompletFichier As String)
Dim fUtf8 As ADODB.Stream 'flux de données Utf8
Dim tbl As Variant 'tableau des valeurs
Dim cel As Range 'cellule destination
Dim txt As String 'texte
Dim lgn As String 'ligne
Dim nbL As Long 'nomnre de lignes
Dim nbC As Long 'nomnre de colonnes
Dim lgr As Long 'longueur
Set fUtf8 = New Stream
With fUtf8
' Définir le flux de données Utf8
.Charset = "utf-8" ' ou autre
.Mode = adModeReadWrite
.Type = adTypeText
.LineSeparator = adCRLF
' Ouvrir le flux et charger le contenu du fichier
.Open
.LoadFromFile nomCompletFichier
' Déterminer la taille du tableau
Do Until .EOS
lgn = txt & .ReadText(-2) '-2 = une ligne
lgr = Len(lgn) - Len(Replace(lgn, idTxt, ""))
If (lgr Mod 2) = 0 Then
' la ligne est complète : compter les colonnes
Call CompterColonnesCSV(lgn, nbC)
txt = "": nbL = nbL + 1
Else
' la ligne est incomplète : la concaténer avec la précédente
txt = txt & lgn & sepL
End If
Loop
' Remplir le tableau
ReDim tbl(1 To nbL, 1 To nbC)
.Position = 0: nbL = 0
Do Until .EOS
lgn = txt & .ReadText(-2)
lgr = Len(lgn) - Len(Replace(lgn, idTxt, ""))
If (lgr Mod 2) = 0 Then
' la ligne est complète : l'enregistrer dans le tableau
nbL = nbL + 1
Call RemplirLigneTableauCSV(tbl, lgn, nbL)
txt = ""
Else
' la ligne est incomplète : la concaténer avec la précédente
txt = txt & lgn & sepL
End If
Loop
.Close
End With
Set fUtf8 = Nothing
' Ecrire le tableau sur la feuille
wsh.UsedRange.Offset(1).Clear
wsh.Cells.ClearContents
Set cel = wsh.Range("A1")
cel.Resize(UBound(tbl, 1), UBound(tbl, 2)).FormulaLocal = tbl 'si les date sont au format local
' cel.Resize(UBound(tbl, 1), UBound(tbl, 2)).Formula = tbl 'si les date sont au anglais
End Sub
Private Sub CompterColonnesCSV(lgn As String, nbC As Long)
Dim txt As String 'texte
Dim nfo As String 'info (champ)
Dim lgr As Long 'longueur
Dim qté As Long 'quantité de colonnes
Dim t As Variant 'Tableau des champs bruts
Dim i As Long 'index
If lgn = "" Then Exit Sub
t = Split(lgn, sepV)
For i = LBound(t) To UBound(t)
nfo = txt & t(i)
lgr = Len(nfo) - Len(Replace(nfo, idTxt, ""))
If (lgr Mod 2) = 0 Then
' le champ est complet
txt = "": qté = qté + 1
Else
' le champ est incomplet : le concaténer avec le précédent
txt = txt & nfo & sepV
End If
Next i
If qté > nbC Then nbC = qté
End Sub
Private Sub RemplirLigneTableauCSV(tbl As Variant, lgn As String, nbL As Long)
Dim txt As String 'texte
Dim nfo As String 'info (champ)
Dim lgr As Long 'longueur
Dim nbC As Long 'nombre de colonnes
Dim t As Variant 'Tableau des champs bruts
Dim i As Long 'index
If lgn = "" Then Exit Sub
t = Split(lgn, sepV)
For i = LBound(t) To UBound(t)
nfo = txt & t(i)
lgr = Len(nfo) - Len(Replace(nfo, idTxt, ""))
If (lgr Mod 2) = 0 Then
' le champ est complet
If Mid(nfo, 1, 1) = idTxt Then
' le texte est délimité, enlever les délimiteurs
nfo = Mid(nfo, 2, Len(nfo) - 2)
' remplacer les doubles délimiteurs pas un simple délimiteur
nfo = Replace(nfo, idTxt & idTxt, idTxt)
End If
' écrire le champ dans le tableau
nbC = nbC + 1
tbl(nbL, nbC) = nfo
txt = ""
Else
' le champ est incomplet : le concaténer avec le précédent
txt = txt & nfo & sepV
End If
Next i
End Sub |
