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
| Option Compare Database
Public Tb() As String
Public t As Integer
Sub ReadTxt()
' Lecture de fichier texte écrit avec PRINT
' Utilisation de la commande LINE INPUT qui lit une ligne au complet
Dim i As Long, j As Long, ar
Dim ValCompo, ValProd As String
Dim iFile As Integer
Dim data
Dim InitialDirectory As String
Dim longueur As Integer
Dim deb, debut As String
Dim ValRefProd As String
'Lecture du fichier et ecriture dans BDD
Dim Rep
Dim oFSO, oFic
Dim iFic As Integer
Dim strLigne As String
Set oFSO = CreateObject("Scripting.FileSystemObject")
Rep1 = "T:\ISh\Prg\IS\L1"
Rep2 = "T:\ISh\Prg\IS\L2"
DoCmd.SetWarnings False
CurrentDb.Execute "DELETE * FROM [Communs];"
If oFSO.FolderExists(Rep1) Then
t = 1
For Each oFl In oFSO.GetFolder(Rep1).Files
Fic = Mid(oFl, 18)
'If oFl.ShortName Like "*.txt" Then
intFic = FreeFile
Open Rep1 & "\" & Fic For Input As intFic
ValRefProd = Replace(Fic, ".txt", "")
ReDim Preserve Tb(1 To t)
Tb(t) = ValRefProd
'Debug.Print Tb(t)
t = t + 1
While Not EOF(intFic)
Line Input #intFic, strLigne
If Mid(strLigne, 190, 3) = "Yes" Then
ValRefAnn = Mid(strLigne, 28, 10)
DoCmd.RunSQL "INSERT INTO COMMUNS (Ref_Produit, Ref_Compo) VALUES ('" & ValRefProd & "', '" & ValRefAnn & "')"
Debug.Print ValRefProd & "//" & ValRefAnn
End If
Wend
Close intFic
'End If
Next
End If
If oFSO.FolderExists(Rep2) Then
For Each oFl In oFSO.GetFolder(Rep2).Files
Fic = Mid(oFl, 18)
'If oFl.ShortName Like "*.txt" Then
intFic = FreeFile
Open Rep2 & "\" & Fic For Input As intFic
ValRefProd = Replace(Fic, ".txt", "")
If BoucleSurTabl(ValRefProd, Tb) = False Then GoTo Line1 Else GoTo Line2
Line1: While Not EOF(intFic)
Line Input #intFic, strLigne
If Mid(strLigne, 190, 3) = "Yes" Then
ValRefAnn = Mid(strLigne, 28, 10)
DoCmd.RunSQL "INSERT INTO COMMUNS (Ref_Produit, Ref_Compo) VALUES ('" & ValRefProd & "', '" & ValRefAnn & "')"
Debug.Print ValRefAnn
End If
Wend
Close intFic
Line2: 'End If
Next
End If
DoCmd.SetWarnings True
'Fermer le fichier
Close #iFile
End Sub
'Cette fonction permet de chercher dans un tableau si le produit recherché est présent
Function BoucleSurTabl(chaine As String, Tb) As Boolean
BoucleSurTabl = False
For j = LBound(Tb) To UBound(Tb)
If Tb(j) = chaine Then BoucleSurTabl = True: Exit Function
Next
End Function |
