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
|
Public Sub Lecture_WW(Fichier As String)
Dim liste_champs As New Collection
Dim tab_champs() As String
Dim car, ligne As String
Dim champ As Variant
Dim nb_ligne As Integer
Dim nb_separateur As Integer
Dim taille_fichier, car_lu As Double
Dim separateur As String
Set Liste_MAJ_WW = New Collection
'Dim rep As Long
separateur = conf.separateurWW
' Exit Sub
On Error GoTo fermeture
taille_fichier = FileLen(Fichier): car_lu = 0
Open Fichier For Input As #2
FrmXl.status = "extraction de World Writer"
FrmXl.status.Refresh
While Not (EOF(2))
car = "": ligne = ""
nb_separateur = 0
car = Input(1, #2)
While car <> Chr(10) And Not (EOF(2))
car_lu = car_lu + 1
ligne = ligne + car
car = Input(1, #2)
If car = separateur Then nb_separateur = nb_separateur + 1
Wend
FrmXl.ProgressBar1.Value = car_lu / taille_fichier * 100
FrmXl.Frame1.Caption = Int(FrmXl.ProgressBar1.Value) & "%"
If nb_ligne Mod 40 = 0 Then FrmXl.Frame1.Refresh
If nb_separateur > 2 Then
tab_champs = VBA.Split(ligne, separateur)
Set liste_champs = New Collection
For Each champ In tab_champs
liste_champs.Add Trim(champ)
Next
If liste_champs.item(1) = "REA800A" Then -----code rajouter
nb_separateur = 8 -----code rajouter
End If ----code rajouter pour test en débug et fenètre espionne :P
rep = Liste_MAJ_WW.Count
Liste_MAJ_WW.Add liste_champs, liste_champs.item(3) & liste_champs.item(1)
End If
Wend
Close #2
Exit Sub
fermeture:
Close #2
MsgBox "Erreur de lecture du fichier :" & vbCrLf & err.Description, vbInformation, "Erreur"
Exit Sub
End Sub |
