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
| Option Compare Database
Option Explicit
Public Sub Importer()
On Error GoTo GestionErreurs
Dim obFSO As Scripting.FileSystemObject
Dim obRep As Scripting.Folder
Dim obFichier As Scripting.File
Dim sDateJour As String
Dim dDatejour As Date
Dim rst As Recordset
Dim tbl() As String 'pour splitter l'enregistrement
Dim Composant() As String 'pour séparer le composant d'avec le N° de carte
Dim Panneau As Long
Dim sSql As String
Dim i As Integer
Dim tPanneauxPK As Long
'Recherche du denier N° de clé
tPanneauxPK = Nz(DMax("tPanneauxPK", "tPanneaux"), 0)
Set obFSO = New Scripting.FileSystemObject
Set obRep = obFSO.GetFolder(CurrentProject.Path & "\Donnees")
'Boucle sur les fichiers
For Each obFichier In obRep.Files
If Right(obFichier.Name, 4) <> "stat" Then GoTo AuFichierSuivant
'Capter la date du fichier
sDateJour = Left(obFichier.Name, 8)
'Renommer le fichier
obFichier.Name = Left(obFichier.Name, Len(obFichier.Name) - 4) & "txt"
'Importer
DoCmd.SetWarnings False
'Vidanger tInputBrut
DoCmd.RunSQL "DELETE * FROM tInputBrut;"
'Transférer les données dans la tInputBrut
DoCmd.TransferText acImportDelim, "stat", "tInputBrut", obFichier, False
'Formater la date
dDatejour = DateSerial(Left(sDateJour, 4), Mid(sDateJour, 5, 2), Right(sDateJour, 2))
'Créer un recordset avec tInputBrut
Set rst = CurrentDb.OpenRecordset("tInputBrut")
rst.MoveFirst
'Lire chaque enregistrement l'un après l'autre
Do While Not rst.EOF
'ne laisser qu'un espace entre les champs
rst.Edit
For i = 1 To 10
rst(1) = Replace(rst(1), " ", " ")
Next i
'Spliter les champs
tbl = Split(rst(1), " ")
'Traiter suivant la nature de cet enregistrement
Select Case tbl(0)
Case "#" 'c'est donc un enregistrement pour lequel on ne fait rien
Case Is < "a" 'c'est donc un enregistrement dont le 1er champ est numérique => panneau
tPanneauxPK = tPanneauxPK + 1
sSql = "INSERT INTO tPanneaux ( tPanneauxPK,DateJour, NumInspection,Produit,Panneau, BCompo,MCompo,BFenetre,MFenetre ) " _
& "SELECT " & tPanneauxPK & " As Expr0, " _
& "#" & Format(dDatejour, "mm/dd/yy") & "# As Expr1, " _
& tbl(3) & " As expr2, " _
& """" & tbl(2) & """ As Expr3, " _
& """" & tbl(0) & """ As Expr4, " _
& tbl(4) & " As Expr5, " _
& tbl(5) & " As Expr6, " _
& tbl(6) & " As Expr7, " _
& tbl(7) & " As Expr8 ;"
'Exécuter la requête pour ajouter dans tPanneaux
DoCmd.RunSQL sSql
Case Else 'c'est donc un enregistrement qui décrit une erreur
'Spliter Composant/N° carte
Composant = Split(tbl(0), "-")
'Construire le SQL de la requête pour ajouter dans tErreurs
sSql = "INSERT INTO tErreurs ( tPanneauxFK, NumCarte, Composant, Boitier, Erreur, Fenetre, Operateur ) " _
& "SELECT " & tPanneauxPK & " As Expr1, " _
& Composant(1) & " As Expr4, " _
& """" & Composant(0) & """ As Expr5, " _
& """" & tbl(1) & """ As Expr6, " _
& tbl(5) & " As Expr7, " _
& """" & tbl(2) & tbl(3) & """ As Expr8, " _
& """" & tbl(6) & """ As Expr9;"
'Exécuter la requête pour ajouter dans tErreurs
DoCmd.RunSQL sSql
End Select
'Lire le suivant et boucler
rst.MoveNext
Loop
'Clore le recordset
rst.Close
Set rst = Nothing
AuFichierSuivant:
Next obFichier
Fin:
Set obFSO = Nothing
Set obRep = Nothing
DoCmd.SetWarnings True
GestionErreurs:
Select Case Err.Number
Case 0 ' pas d'erreur
Exit Sub
Case 94 ' enregistrement Nul Nul...
Resume Next
Case Else
MsgBox "Erreur dans Importer : " & Err.Number & "-" & Err.Description & ".", vbCritical
End Select
End Sub |
Partager