Base de données Access 2003

Question

Salut à tous et à toute ! 

Alors voilà, pour la suite de mon projet (en résumé : tri et concaténation de fichier .csv que je peux convertir en fichier .txt si besoin + implantation dans une base de donnnées), je dois implanter des fichiers .csv/.txt dans une base de données. Mon problème est le suivant : 
Les fichiers que je dois insérer dans ma base de données sont de la forme suivante (<ETX> correspond à un nouveau test)

La table "Réglage" servira surtout pour l'IHM par la suite, pour le moment ce n'est pas mon principal problème. J'aimerais implanter tout mes fichiers mais en répartissant les données. Les fichiers sont long et, dans un fichier, il peut y avoir plusieurs test. Comment dire à une base de données de prendre les deux premières lignes d'un test de les mettre dans la table FICHIER et le reste dans MESURE et ceux jusqu'au prochain test pour recommencer l'opération ? 

Merci pour vos indications, aides ou conseils,
Bonne journée !

blux · Answer

Salut,

une procédure d'importation de fichier en VBA me semble être la solution la plus appropriée pour ce faire...

blux · Answer

Voila donc ce que je propose :

Une table ETX, sachant que le numéro d'ETX sera unique.
Une table TEST, sachant qu'on pourra avoir plusieurs tests par ETX, la discrimination sera faite avec l'horodatage, puisqu'on ne pourra pas tester un ETX plusieurs fois en même temps.
Une table MESURE, sachant que pour chaque couple ETX-horodatage de test, on pourra avoir n composants avec chacun des unités différentes, des valeurs différentes.

Par contre, je viens de regarder les fichiers d'un petit plus plus près, il y a des lignes qui n'ont pas le même nombre de champs, il va falloir des règles de gestion bien ciblées.

Pour le recordset, on verra après, dès que tu penses que le modèle de données semble correct.

M6sou · Answer

Voilà les tables et les relations avec toutes les informations nécéssaire faites ! 
On va pouvoir passer au plus dur du boulot !

blux · Answer

Voilà ce qu'on peut faire :

Private Sub Commande0_Click()
Dim RSETX As DAO.Recordset
Dim RSTEST As DAO.Recordset
Dim RSMESURE As DAO.Recordset
Dim Ligne As String
Dim Etx As String
Dim Test As String
Set RSETX = CurrentDb.OpenRecordset("ETX", dbOpenTable)
Set RSTEST = CurrentDb.OpenRecordset("TEST", dbOpenTable)
Set RSMESURE = CurrentDb.OpenRecordset("MESURE", dbOpenTable)
FicImport = "D:\*****\ACC\etx\Tss_data0204131343.txt"
'MsgBox FicImport
Open FicImport For Input As #1
Line Input #1, Ligne
Do While Not EOF(1)
    ' La première ligne est toujours ETX
    If Left(Ligne, 5) = "<ETX>" Then
        Etx = Mid(Ligne, 6)
        With RSETX
            .AddNew
            .Fields("Etx").Value = Etx
            .Fields("Nom").Value = "toto"
            On Error Resume Next
            .Update
            ' MsgBox "etx"
            ' Si erreur 3022, clé primaire déjà connue -> on continue
            ' sinon erreur à traiter...
            If Err.Number <> 3022 And Err.Number <> 0 Then
                MsgBox "Erreur " & Err.Number & vbCrLf & Err.Description, vbCritical, "Erreur insertion ETX"
            End If
        End With
    Else
        MsgBox "La ligne n'est pas une ligne ETX " & Ligne & vbCrLf, vbCritical, "Erreur lecture fichier"
    End If
    ' La ligne suivante est toujours un horodatage
    Line Input #1, Ligne
    If Mid(Ligne, 2, 8) Like "##-##-##" Then
        With RSTEST
            .AddNew
            .Fields("etx").Value = Etx
            .Fields("horo").Value = Ligne
            'MsgBox "test"
            .Update
        End With
    Else
        MsgBox "La ligne n'est pas une ligne d'horodatage " & Ligne & vbCrLf, vbCritical, "Erreur lecture fichier"
    End If
    ' Boucle sur mesure tant que etx non trouvé
    Do
        Line Input #1, Ligne
        'MsgBox Ligne
        If Left(Ligne, 5) = "<ETX>" Or EOF(1) Then
            'MsgBox "nouveau etx"
            Exit Do
        End If
        With RSMESURE
            .AddNew
            .Fields("nom").Value = Ligne
            'MsgBox "mesure"
            .Update
        End With
    Loop While True
Loop
Close #1
RSETX.Close
RSTEST.Close
RSMESURE.Close
Set RSETX = Nothing
Set RSTEST = Nothing
Set RSMESURE = Nothing
End Sub

La gestion des erreurs est faite a minima, on considère que le flux est toujours correctement structuré : pas de mesures orphelines, un horodatage suit toujours un etx, pas de lignes blanches...

Reste ensuite à savoir comment tu découpes chaque ligne de mesure, savoir si tu découpe l'horodatage en date et heure, si tu rajoutes la durée... Mais je pense que l'essentiel y est.

Je n'ai pas non plus mis la boucle pour traiter tous les fichiers d'un répertoire choisi par l'utilisateur.

<edit> : lorsque tu feras des essais, la table mesure ne va faire que se remplir car la clé primaire est un numéroauto, tu n'auras jamais de doublons, pense à la vider quand tu feras des vérifications

A+ blux

 "Les cons, ça ose tout.
C'est même à ça qu'on les reconnait"

blux · Answer

Voila ce que ça donne (le code a été repensé, je te conseille de faire un copier/coller chez toi) :

Private Sub Commande0_Click()
Dim Repertoire As Office.FileDialog
Dim Rep As String
Dim RSETX As DAO.Recordset
Dim RSTEST As DAO.Recordset
Dim RSMESURE As DAO.Recordset
Dim Ligne As String
Dim Etx As String
Dim Horod As String
Dim Test As String
Dim Complement As String
Dim ListeMesure() As String
Dim I As Integer
Dim Boo_Etx As Boolean
Dim Boo_Test As Boolean
Set RSETX = CurrentDb.OpenRecordset("ETX", dbOpenTable)
Set RSTEST = CurrentDb.OpenRecordset("TEST", dbOpenTable)
Set RSMESURE = CurrentDb.OpenRecordset("MESURE", dbOpenTable)
 'Choix du répertoire de travail
Set Repertoire = Application.FileDialog(msoFileDialogFolderPicker)
Repertoire.Title = "Sélectionnez un répertoire..."
Repertoire.Show
If Repertoire.SelectedItems.Count < 1 Then
    MsgBox "Aucun répertoire sélectionné !!!", vbOKOnly
    Exit Sub
End If
'MsgBox Repertoire.SelectedItems(1)
Rep = Dir(Repertoire.SelectedItems(1) & "\", vbDirectory)
 ' Boucle tant que le répertoire n'a pas été entièrement parcouru
Do While (Rep <> "")
    ' Teste si c'est un fichier ou un répertoire
    If (GetAttr(Repertoire.SelectedItems(1) & "\" & Rep) And vbDirectory) <> vbDirectory Then
        If Right(Rep, 4) = ".txt" Then
            Ficimport = Repertoire.SelectedItems(1) & "\" & Rep
            'MsgBox Ficimport
            'Ouvre le fichier et lit son contenu
            Open Ficimport For Input As #1
            Line Input #1, Ligne
            Boo_Etx = False
            Boo_Test = False
            Do While Not EOF(1)
                ' La première ligne est toujours ETX
                If Left(Ligne, 5) = "<ETX>" Then
                    Etx = Mid(Ligne, 6)
                    ' Marquage si etx trouvé
                    Boo_Etx = True
                Else
                    MsgBox "La ligne n'est pas une ligne ETX " & Ligne & vbCrLf, vbCritical, "Erreur lecture fichier"
                End If
                On Error Resume Next
                ' La ligne suivante est toujours un horodatage
                Line Input #1, Ligne
                If Err.Number = 62 Then
                    Exit Do
                ElseIf Err.Number <> 0 Then
                    MsgBox "Erreur " & Err.Number & vbCrLf & Err.Description, vbCritical, "Erreur lecture horodatage"
                    Exit Do
                End If
                On Error GoTo 0
                If Mid(Ligne, 2, 8) Like "##-##-##" Then
                    Horod = Mid(Ligne, 1, 17)
                    ' Marquage si horo trouuvé
                    Boo_Test = True
                Else
                   MsgBox "La ligne n'est pas une Ligne d'horodatage " & Ligne & vbCrLf, vbCritical, "Erreur lecture fichier"
                End If
                ' Boucle sur mesure tant que etx non trouvé
                Do
                    Line Input #1, Ligne
                    If Err.Number = 62 Then
                        Exit Do
                    ElseIf Err.Number <> 0 Then
                        MsgBox "Erreur " & Err.Number & vbCrLf & Err.Description, vbCritical, "Erreur lecture horodatage"
                        Exit Do
                    End If
                    On Error GoTo 0
                    'MsgBox Ligne
                    If Left(Ligne, 5) = "<ETX>" Or EOF(1) Then
                        'MsgBox "nouveau etx"
                        Exit Do
                    End If
                    ListeMesure = Split(Ligne)
                    'For I = 0 To UBound(ListeMesure)
                    'MsgBox ListeMesure(I)
                    'Next
                    ' Si etx et horo trouvés, on les écrit
                    If Boo_Etx And Boo_Test Then
                        With RSETX
                            .AddNew
                            .Fields("Etx").Value = Etx
                            .Fields("NomCarte").Value = Mid(Etx, 1, InStr(Etx, " "))
                            .Fields("NS").Value = Mid(Etx, InStr(Etx, " ") + 1, 6)
                            On Error Resume Next
                            .Update
                            ' MsgBox "etx"
                            ' Si erreur 3022, clé primaire déjà connue -> on continue
                            ' sinon erreur à traiter...
                            If Err.Number <> 3022 And Err.Number <> 0 Then
                                MsgBox "Erreur " & Err.Number & vbCrLf & Err.Description, vbCritical, "Erreur insertion ETX"
                            End If
                            On Error GoTo 0
                        End With
                        With RSTEST
                            .AddNew
                            .Fields("Etx").Value = Etx
                            .Fields("horo").Value = Horod
                            .Fields("Durée").Value = Mid(Ligne, 19, 8)
                            On Error Resume Next
                            .Update
                            'MsgBox "test"
                            ' Si erreur 3022, clé primaire déjà connue -> on continue
                            ' sinon erreur à traiter...
                            If Err.Number <> 3022 And Err.Number <> 0 Then
                                MsgBox "Erreur " & Err.Number & vbCrLf & Err.Description, vbCritical, "Erreur insertion TEST"
                            End If
                            On Error GoTo 0
                        End With
                        ' On remet à faux pour n'écrire qu'une fois le couple pour les mesures trouvées
                        Boo_Etx = False
                        Boo_Test = False
                    End If
                    ' Ecriture de la mesure
                    With RSMESURE
                        .AddNew
                        .Fields("Etx").Value = Etx
                        .Fields("horo").Value = Horod
                        Complement = ""
                        If Left(ListeMesure(0), 1) = "S" Then
                            .Fields("Nom").Value = Mid(ListeMesure(0), 4, 20)
                            .Fields("Valeur mesuree").Value = Replace(ListeMesure(1), ".", ",")
                            .Fields("Unite").Value = ListeMesure(2)
                            For I = 3 To UBound(ListeMesure)
                                If Left(ListeMesure(I), 1) = "&" Or Left(ListeMesure(I), 1) = ";" Then
                                    .Fields("Valeur min").Value = Replace(Mid(ListeMesure(I), 2, 30), ".", ",")
                                ElseIf Left(ListeMesure(I), 1) = "$" Or Left(ListeMesure(I), 1) = "?" Then
                                    .Fields("Valeur max").Value = Replace(Mid(ListeMesure(I), 2, 30), ".", ",")
                                ElseIf Left(ListeMesure(I), 1) = "N" Then
                                    .Fields("Valeur nomi").Value = Replace(Mid(ListeMesure(I), 2, 30), ".", ",")
                                Else
                                    Complement = Complement & " " & ListeMesure(I)
                                End If
                            Next
                        End If
                        .Fields("Complement").Value = Complement
                        On Error Resume Next
                        .Update
                        'MsgBox "mesure"
                        ' Erreur à traiter...
                        If Err.Number <> 0 Then
                            MsgBox "Erreur " & Err.Number & vbCrLf & Err.Description, vbCritical, "Erreur insertion MESURE"
                        End If
                        On Error GoTo 0
                    End With
                Loop While True
            Loop
            Close #1
        End If
    End If
    ' Passe au fichier suivant
    Rep = Dir
Loop
RSETX.Close
RSTEST.Close
RSMESURE.Close
Set RSETX = Nothing
Set RSTEST = Nothing
Set RSMESURE = Nothing
End Sub

Base de données Access 2003

5 réponses

Discussions similaires

Newsletters