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
| Public Sub ImporterA(strNomFichier As String)
Dim FSO As New Scripting.FileSystemObject
Dim oFichier As Scripting.TextStream
Dim strLigne As String
Dim strNomChamp As String
Dim strValeur As String
Set oFichier = FSO.OpenTextFile(strNomFichier, ForReading)
Dim oRst As DAO.Recordset
Dim I As Integer
'Charge la table en mémoire
Set oRst = CurrentDb.OpenRecordset("classe A", dbOpenTable)
'Tant que non fin de fichier
While Not oFichier.AtEndOfStream
'lit la ligne
strLigne = oFichier.ReadLine
'Si elle n'est pas vide
If Trim(strLigne) <> "" Then
'Si c'est une ligne de date
If InStr(1, strLigne, "/") <> 0 Then
If InStr(1, Trim(strLigne), "/") = 1 Then
datea = Mid(Trim(strLigne), 2, 16)
d = CDate(Mid(datea, 1, 8))
heure = CInt(Mid(datea, 10, 2))
min = CInt((Mid(datea, 15, 2)))
annee = Day(d)
If Year(d) < 2000 Then
jour = Year(d) - 1900
Else
jour = Year(d) - 2000
End If
Mois = Month(d)
dc = jour & "-" & Mois & "-" & annee
d = CDate(dc)
datea = d
End If
If InStr(1, Trim(strLigne), "/") > 1 Then
datea = Mid(Trim(strLigne), 1, 16)
End If
'Si on est sur un nouvel enregistrement, on le valide
If oRst.EditMode = dbEditAdd Then oRst.Update
Else
'Sinon, si on est pas en mode ajout, on ajoute un nouvel enregistrement
If Not oRst.EditMode = dbEditAdd Then
oRst.AddNew
'Fixe le numéro
oRst.Fields("NumeroA") = oRst.RecordCount + 1
oRst.Fields("dateA") = datea
oRst.Fields("heure") = heure
oRst.Fields("minute") = min
End If
'Récupère la position des :
I = InStr(1, strLigne, "=", vbTextCompare)
If I > 0 Then
'Récupère le nom du champ et la valeur
strNomChamp = Trim(Mid(strLigne, I - 4, 4))
strValeur = Trim(Mid(strLigne, I + 1, 10))
strNomChamp1 = Trim(Mid(strLigne, I + 12, 3))
strValeur1 = Trim(Mid(strLigne, I + 17, 10))
strNomChamp2 = Trim(Mid(strLigne, I + 28, 3))
strValeur2 = Trim(Mid(strLigne, I + 33, 10))
'MsgBox strNomChamp
' MsgBox strValeur
'Remplit la table
oRst.Fields(strNomChamp).Value = strValeur
oRst.Fields(strNomChamp1).Value = strValeur1
oRst.Fields(strNomChamp2).Value = strValeur2
End If
End If
End If
Wend
'Ferme tout
If oRst.EditMode = dbEditAdd Then
oRst.Update
End If
oFichier.Close
oRst.Close
Set oRst = Nothing
Set oFichier = Nothing
Set FSO = Nothing
End Sub |
Partager