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 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150
|
Option Compare Database
Sub Traitement()
Call Importation("c:\Source.txt")
Call Nettoyage
Call Extraction
Call Exportation("c:\resultat.txt")
End Sub
Sub Importation(fichier As String)
Dim t As DAO.Recordset, s As String
DoCmd.RunSQL "DELETE [tbImport].* FROM [tbImport];"
n = FreeFile
Open fichier For Input As #n
Set t = CurrentDb.OpenRecordset("tbImport")
Do Until EOF(n)
Input #n, s
t.AddNew
t!ligne = Trim$(s)
t.Update
Loop
t.Close
Close (n)
End Sub
Sub Nettoyage()
Dim rst As DAO.Recordset, s As String
Set rst = CurrentDb.OpenRecordset("SELECT tbImport.ligne FROM tbImport ORDER BY tbImport.n;")
Do Until rst.EOF
s = rst!ligne
If Left$(s, 1) = "(" Then
rst.Delete
rst.MoveNext
Do Until rst.EOF
s = rst!ligne
If s = "" Then Exit Do
rst.Delete
rst.MoveNext
Loop
End If
If rst.EOF Then Exit Do
rst.MoveNext
Loop
rst.Close
End Sub
Sub Extraction()
Dim rst As DAO.Recordset, rst2 As DAO.Recordset, s As String, n As Long, n2 As Long, k As Long
DoCmd.RunSQL "DELETE tbResultat.* FROM tbResultat;"
Set rst = CurrentDb.OpenRecordset("SELECT tbImport.ligne FROM tbImport ORDER BY tbImport.n;")
Set rst2 = CurrentDb.OpenRecordset("tbResultat")
Do Until rst.EOF
s = rst!ligne
If s = "" Then k = 0
If PresenceCodePostal(s) > 0 Then
k = 2 'adresse
Else
If InStr(1, s, "Tél. :") > 0 Then
k = 3 'telephone
Else
If k > 1 Then
k = 4 'adresse internet
Else
k = 1 'ecole
End If
End If
End If
Select Case k
Case 0
rst2.AddNew
rst2!ligne = ";"
rst2.Update
Case 1
rst2.AddNew
rst2!ligne = s
rst2.Update
Case 2 'adresse
n = PresenceCodePostal(s)
rst2.AddNew
rst2!ligne = Trim$(Left$(s, n - 1))
rst2.Update
rst2.AddNew
rst2!ligne = Trim$(Mid$(s, n, 5))
rst2.Update
rst2.AddNew
rst2!ligne = Trim$(Mid$(s, n + 6))
rst2.Update
Case 3 'telephone
n = InStr(1, s, "Tél. :")
rst2.AddNew
rst2!ligne = Mid$(s, n + 7, 15)
rst2.Update
Case 4 'internet
rst2.AddNew
rst2!ligne = s
rst2.Update
End Select
rst.MoveNext
Loop
End Sub
Function PresenceCodePostal(s As String) As Long
Dim v As Variant, i As Long, n As Long
'remplace les espaces multiples par 1 espace
For i = 20 To 1 Step -1
s = Replace(s, Space$(i), " ")
Next i
'on eclate la chaine
v = Split(s, " ")
n = UBound(v)
'on estime qu'un nombre à 5 chiffres est le code postal
For i = 1 To n
If Len(v(i)) = 5 Then
If IsNumeric(v(i)) Then PresenceCodePostal = InStr(1, s, v(i))
Exit For
End If
Next i
End Function
Sub Exportation(fichier As String)
Dim rst As DAO.Recordset, s As String
n = FreeFile
Open fichier For Output As #n
Set rst = CurrentDb.OpenRecordset("tbResultat")
Do Until rst.EOF
Print #n, rst!ligne
rst.MoveNext
Loop
rst.Close
Close (n)
End Sub |
Partager