Sujet Précédent Sujet Suivant

Base de données Access 2003

Fermé
M6sou Messages postés 70 Date d'inscription lundi 26 mai 2014 Statut Membre Dernière intervention 13 juin 2014 - 2 juin 2014 à 15:15
M6sou Messages postés 70 Date d'inscription lundi 26 mai 2014 Statut Membre Dernière intervention 13 juin 2014 - 13 juin 2014 à 11:24
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 !

5 réponses

Réponse 1 / 5
blux Messages postés 26536 Date d'inscription dimanche 26 août 2001 Statut Modérateur Dernière intervention 19 décembre 2024 3 317
2 juin 2014 à 15:18
Salut,

une procédure d'importation de fichier en VBA me semble être la solution la plus appropriée pour ce faire...
0
M6sou Messages postés 70 Date d'inscription lundi 26 mai 2014 Statut Membre Dernière intervention 13 juin 2014
2 juin 2014 à 15:28
Salut blux,

Je vous avouerais que je craignais un peu cette réponse :D
J'ai des bases en vba (surtout sous excel et word), mais sous access, je vous cache pas que je pars de loin je pense.
Auriez vous un lien avec des tutos sous la main par hasard ?
0
blux Messages postés 26536 Date d'inscription dimanche 26 août 2001 Statut Modérateur Dernière intervention 19 décembre 2024 3 317
2 juin 2014 à 16:24
Pas de tutos, mais j'ai du répondre à un certain nombre de sujet comme celui-ci dans le forum, cherche un peu au niveau 'importation' avec mon pseudo. On verra sur quoi on tombe et on avisera/adaptera en conséquence...
0
M6sou Messages postés 70 Date d'inscription lundi 26 mai 2014 Statut Membre Dernière intervention 13 juin 2014
3 juin 2014 à 08:43
https://forums.commentcamarche.net/forum/affich-27798728-importation-automatique-sous-access-vba

J'ai trouvé ce sujet, pour lequel tu as aidé à la résolution, qui semble se rapprocher de mon sujet. Mais je ne vois pas comment l'adapter à mon problème.
Existe-il une commande access qui permet de dire "si format xx-xx-xx mettre dans la table Fichier sous date" ou "si commencce par '&' mettre dans la tabke Mesure sous VBasse" par exemple ?
0
blux Messages postés 26536 Date d'inscription dimanche 26 août 2001 Statut Modérateur Dernière intervention 19 décembre 2024 3 317
3 juin 2014 à 10:09
Cette commande n'existera dans aucun langage, puisque c'est toi qui fixe les règles de gestion.
Tu devras donc importer ton fichier dans une table temporaire, lire ensuite cette table et en fonction de ce que tu y trouves, faire les traitements que tu souhaites.
Mais tu verras, c'est finalement assez simple.
L'importation peut être faite grâce au code VBA du post qui tu as retrouvé (moyennant modifs...).
Quant à la suite, elle consiste à 'jouer' avec les recordset (jeu d'enregistrement) et avec des fonctions de découpage de chaine pour extraire les données intéressantes mâtiné d'un peu de tests et de boucles... Si tu connais le VBA, rien d'insurmontable.
0
M6sou Messages postés 70 Date d'inscription lundi 26 mai 2014 Statut Membre Dernière intervention 13 juin 2014
3 juin 2014 à 11:13
Donc, je dois :
-Importer, via VBA, tout mes fichiers dans une table X
-Trier la table X en fonction des informations qui s'y trouve, et où je veux les mettre

Concernant l'importation, si j'ai bien saisis, elle se fait grâce à l'outil "Docmd.Transfert" ?
0
Réponse 2 / 5
blux Messages postés 26536 Date d'inscription dimanche 26 août 2001 Statut Modérateur Dernière intervention 19 décembre 2024 3 317
5 juin 2014 à 13:47
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.
0
M6sou Messages postés 70 Date d'inscription lundi 26 mai 2014 Statut Membre Dernière intervention 13 juin 2014
5 juin 2014 à 13:57
C'est presque ça, il manque juste deux petites données dans la table MESURE:
valeur nominal (donné avec l'indication N devant la valeur) et la validité de la mesure du coups.

Au passage pour information, la valeur min se voit avec l'indicateur '&' et la valeur max avec l'indicateur '$' avant la valeur. La valeur mesuré, elle, n'a pas d'indicateu, elle se trouve juste après sa référence et avant son unité.

Mais sinon, le modèle de donnée est correcte avec ceux que je souhaite réaliser :D
0
M6sou Messages postés 70 Date d'inscription lundi 26 mai 2014 Statut Membre Dernière intervention 13 juin 2014
5 juin 2014 à 15:14
Ah et autre chose que je viens de voir, le numéro de série est également a prendre en compte dans ETX, le nom et le numéro de série font l'ETX
0
blux Messages postés 26536 Date d'inscription dimanche 26 août 2001 Statut Modérateur Dernière intervention 19 décembre 2024 3 317
5 juin 2014 à 15:30
Les colonnes supplémentaires des tables peuvent être rajoutées après, si le besoin s'en fait sentir.
Le principal problème est la définition des clés primaires et les relations entre tables.

le nom et le numéro de série font l'ETX
C'est pas grave, ce sera à toi de concaténer les infos que tu veux pour en faire une clé primaire.

Crée donc tes tables et les relations (avec intégrité référentielle) et ensuite on attaquera le gros du boulot :

- parcours d'un fichier
- analyse et découpage de chaque ligne
- remplissage des tables au fur et à mesure
- ...
0
Réponse 3 / 5
M6sou Messages postés 70 Date d'inscription lundi 26 mai 2014 Statut Membre Dernière intervention 13 juin 2014
Modifié par M6sou le 5/06/2014 à 15:48
Voilà les tables et les relations avec toutes les informations nécéssaire faites !

On va pouvoir passer au plus dur du boulot !
0
blux Messages postés 26536 Date d'inscription dimanche 26 août 2001 Statut Modérateur Dernière intervention 19 décembre 2024 3 317
Modifié par blux le 5/06/2014 à 21:36
Voilà comment on peut écrire dans la table ETX la clé de chaque etx trouvé dans un fichier (tu adapteras le nom du fichier) : 

Private Sub Commande0_Click()
Dim RSETX As DAO.Recordset
Dim RSTEST As DAO.Recordset
Dim RSMESURE As DAO.Recordset
Dim Ligne As String
Dim Lig_Etx As String
Set RSETX = CurrentDb.OpenRecordset("ETX", dbOpenTable)
Set RSTEST = CurrentDb.OpenRecordset("TEST", dbOpenTable)
Set RSMESURE = CurrentDb.OpenRecordset("MESURE", dbOpenTable)
FicImport = "C:\toto.txt"
'MsgBox FicImport
Open FicImport For Input As #1
Do While Not EOF(1)
    Line Input #1, Ligne
    If Left(Ligne, 5) = "<ETX>" Then
        Lig_Etx = Mid(Ligne, 6)
        With RSETX
            .AddNew
            .Fields("Etx").Value = Lig_Etx
            .Fields("Nom").Value = "toto"
            .Update
        End With
    End If
Loop
Close #1
RSETX.Close
RSTEST.Close
RSMESURE.Close
Set RSETX = Nothing
Set RSTEST = Nothing
Set RSMESURE = Nothing
End Sub


Bien sûr, il n'y a pas d'interception d'erreur (etx déjà présent, par exemple), mais ça te donne la méthode d'écriture en vba dans une table.
J'ai mis la description des autres recordset car on va s'en servir au fil de l'eau.

Je n'ai toutefois pas testé le code, il est possible que tu aies des erreurs, mais on corrigera....

Si toutefois tu as une erreur sur librairie ou bibliothèque non trouvée au niveau de la définition dao, tu vas aller (une fois que le code est planté et que tu est dans la fenêtre code) dans le menu 'Outils/référence' et vas chercher dans la liste de ce qui n'est pas coché un 'microsoft DAO xx.x object library que tu cocheras, ça devrait résoudre ce problème éventuel.
0
M6sou Messages postés 70 Date d'inscription lundi 26 mai 2014 Statut Membre Dernière intervention 13 juin 2014
5 juin 2014 à 20:00
Merci pour la méthode d'écriture, je regarderais ça de plus près demain matin et reviendrais vers toi. :-)
0
M6sou Messages postés 70 Date d'inscription lundi 26 mai 2014 Statut Membre Dernière intervention 13 juin 2014
Modifié par M6sou le 10/06/2014 à 08:51
Salut Blux, désolez pour le temps de réponse j'ai eu quelques soucis personnel à régler.
J'ai bien lancé le code que tu m'as passé, néanmoins j'ai une erreur 3022:
Modifications non effectuées : risques de doublons dans champs index, clé principale, ou relation interdisant les doublons. Modifiez les données des champs contenant les doublons, enlevez ou redefinissez l'index pour permettre les doublons et recommencez"

Je cherche de mon côté d'où cela peut provenir, mais si tu as une idée je suis preneur !
0
blux Messages postés 26536 Date d'inscription dimanche 26 août 2001 Statut Modérateur Dernière intervention 19 décembre 2024 3 317
10 juin 2014 à 09:10
C'est ce que je disais, tu as sûrement une clé primaire qui existe déjà, cas typique : un etx déjà enregistré dans la table etx...
Dans ce cas, il ne faudra pas enregistrer cet etx mais seulement les informations qu'il apporte dans les autre tables...
0
M6sou Messages postés 70 Date d'inscription lundi 26 mai 2014 Statut Membre Dernière intervention 13 juin 2014
10 juin 2014 à 09:20
En faites, le problème si j'ai bien saisis, c'est que lorsqu'il trouve un etx déjà dans la base de données, il se met en erreur pour ne pas faire de doublon. Donc lorsqu'il y a deux etx identique, le programme doit faire abstraction de cette ligne et ne prendre en compte que l'horodatage + mesure.
Mais pour le faire, il faut réaliser le recordset de mesure c'est ça ?
0
Réponse 4 / 5
blux Messages postés 26536 Date d'inscription dimanche 26 août 2001 Statut Modérateur Dernière intervention 19 décembre 2024 3 317
Modifié par blux le 10/06/2014 à 14:21
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"
0
M6sou Messages postés 70 Date d'inscription lundi 26 mai 2014 Statut Membre Dernière intervention 13 juin 2014
10 juin 2014 à 16:22
Merci beaucoup, c'est exactement ça.
Là je travaille sur la table de mesure, je voulais savoir si lorsque j'écris cela :
Mid(Ligne, InStr(Ligne, " "), InStr(Ligne," ") + 1))

Cela dit ien de prendre la donnée entre le premier espace et le second ?
Parce que j'essaye de la mettre dans le programme mais rien ne se passe du côté de la table mesure. Elle reste vide...
0
blux Messages postés 26536 Date d'inscription dimanche 26 août 2001 Statut Modérateur Dernière intervention 19 décembre 2024 3 317
10 juin 2014 à 17:13
Tu peux faire beaucoup mieux, à mon avis, car je vois ta problématique : récupérer les mesures séparées par des espaces.
... 
Dim ListeMesure() As String
Dim I As Integer
...
ListeMesure = Split(Ligne)
For I = 0 To ListeMesure - 1
    Msgbox ListeMesure(I)
Next
...


Avec ça, tu sépares la ligne en chaines qui sont mises une par une dans le tableau ListeMesure (séparateur par défaut : espace). Ca devrait éviter beaucoup de instr, len, mid, left et autres fonctions... A toi ensuite de les mettre dans les champs de RSMESURE en fonction de ce qui i t'intéresse.
0
blux Messages postés 26536 Date d'inscription dimanche 26 août 2001 Statut Modérateur Dernière intervention 19 décembre 2024 3 317
10 juin 2014 à 18:44
Et puis en mettant un peu de code pour choisir un répertoire et boucler sur tous les fichiers .txt qui y sont, ça donne ça : 

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 Test As String
Dim ListeMesure() As String
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
            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
                    ListeMesure = Split(Ligne)
                    With RSMESURE
                        .AddNew
                        .Fields("nom").Value = Ligne
                        'MsgBox "mesure"
                        .Update
                    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


J'ai laissé des msgbox pour voir où on en est, tu pourras bien sûr les faire sauter...
Si tu as une erreur sur la définition de l'objet Office.FileDialog, tu fais comme pour DAO, tu vas dans les références et tu coches 'Microsoft Office xx.x Object LIbrary
0
M6sou Messages postés 70 Date d'inscription lundi 26 mai 2014 Statut Membre Dernière intervention 13 juin 2014
10 juin 2014 à 18:48
Cool, merci je regarderais ça demain matin ! En tout cas, merci tu m'auras grandement aidé !
0
M6sou Messages postés 70 Date d'inscription lundi 26 mai 2014 Statut Membre Dernière intervention 13 juin 2014
11 juin 2014 à 08:38
Dernier petit problème au niveau du code, et de la table MESURE. Les tables TEST et ETX se remplissent parfaitement bien mais pas la table MESURE qui elle ne se remplit pas du tout, elle reste vide... 

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 Test As String
Dim ListeMesure() As String
Dim I As Integer
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
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("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
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
horo = Ligne
With RSTEST
.AddNew
.Fields("Etx").Value = Etx
.Fields("horo").Value = Mid(horo, 1, 17)
.Fields("Durée").Value = Mid(horo, 19, 8)
'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
Line Input #1, Ligne
ListeMesure = Split(Ligne)
For I = 0 To ListeMesure(I) - 1
'MsgBox ListeMesure(I)
Next
With RSMESURE
.AddNew
.Fields("Etx").Value = Etx
.Fields("horo").Value = horo
.Fields("Nom").Value = ListeMesure(I) = 0
.Fields("Unite").Value = ListeMesure(I) = 2
.Fields("Valeur mesuree").Value = ListeMesure(I) = 1
.Fields("Valeur min").Value = ListeMesure(I) = 3
.Fields("Valeur max").Value = ListeMesure(I) = 4
.Fields("Valeur nomi").Value = ListeMesure(I) = 5
'MsgBox "mesure"
.Update
End With
Loop While True
Loop
Close #1
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

Je ne sais pas si c'est un problème lié à la boucle For (mais ça m'étonnerais pcq elle découpe bien , le seul soucis c'est qu'elle découpe une ligne du premier fichier et s'arrête..)
0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
Réponse 5 / 5
blux Messages postés 26536 Date d'inscription dimanche 26 août 2001 Statut Modérateur Dernière intervention 19 décembre 2024 3 317
13 juin 2014 à 10:40
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

0
M6sou Messages postés 70 Date d'inscription lundi 26 mai 2014 Statut Membre Dernière intervention 13 juin 2014
13 juin 2014 à 11:13
Je l'essaierais après, là j'ai compris pourquoi j'ai une erreur 9 constamment.
Par moment dans les fichiers il y a des lignes :
Su'DECHARGE

du coups il ne sais pas quoi en faire. Alors je lui ai dis que Si il trouvait un "S*" il faisait le programme normalement sinon si il trouve "Su'" il va directement a Next For sans prendre en compte la ligne
0
blux Messages postés 26536 Date d'inscription dimanche 26 août 2001 Statut Modérateur Dernière intervention 19 décembre 2024 3 317
13 juin 2014 à 11:22
D'où l'intérêt d'avoir un inventaire exhaustif, patati et patata...
0
M6sou Messages postés 70 Date d'inscription lundi 26 mai 2014 Statut Membre Dernière intervention 13 juin 2014
13 juin 2014 à 11:24
De base j'avais déjà réalisé une macro de tri des données, je pensais avoir enlevé toutes les données en trop, faut croire que j'avais oublié celle là
0

Discussions similaires

Exemple de base de données access
Abdlahsaki -
Fleptche -

9 réponses
TNT base de donnees vide!!
Angye25 -
Angye25 -

4 réponses
exemple base de données Access de gestion
jack -
sorosoro -

11 réponses
Nettoyer une base de données avec une liste
TOT127 -
TOT127 -

11 réponses
relation d'approbation
leila -
Inf -

22 réponses