Base de données Access 2003

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

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

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