Discussion :

[kiki51500]

Bonjour à tous

Dans ma base je saisie des lignes dans une table
J'ai donc des clients A, B, C... sur lesquels de nombreuses lignes de visites sont crees. je peux donc avoir 10 lignes pour le client A et 5 pour le client B
Je souhaiterai migrer mes clients lorsqu'ils ne sont plus actifs dans une autre table "archive"

J'ai, dans un des champs, un critère noté par mon technicien qui me dit que mon client est inactif (demenagement, deces,...)

J'aimerai construire une requête qui aille a la recherche du critère principal "deces" et me selectionne TOUTES les lignes du client concernés

client date de naissance critere
A XXX OK
A XXX OK
B XXX OK
C XXX OK
A XXX deces
B XXX OK

Sur cet exemple très basique, je souhaiterai donc que ma requête me "migre" toutes les lignes de mon patient A pour lequel on a appris a la 3eme visite qu'il etait décédé et donc récupéré notre matériel.
Pour assurer le risque de client en doublon, j'aimerai de plus que la requete verifie egalement que les lignes A sont bien du meme client en controlant la date de naissance

Est ce possible?

Merci à vous si vous pouvez m'orienter dans mes recherches car je ne sais pas comment l'exprimer dans Google pour avoir des resultats

[amelyfred]

Bonjour,
Tu n'as qu'une table ou tu as une table client et une table visite?
Logiquement tu devrais avoir 2 tables mais en lisant ton post je ne suis pas sûr.
Fred

[kiki51500]

Non effectivement, je n'ai qu'une table (en tout cas pour ma question).
La raison en est qu'historiquement ma table principale vient d'un fichier excel utilisé depuis 2005 que j'ai importé dans access.

Donc dans la meme table j'ai "Client" "date de naissance" et "critere"

As tu une idee

Fred (aussi)

[amelyfred]

Salut
Voici un petit code rapide.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Option Compare Database
Public Sub ClientDeces()
Dim oRst As DAO.Recordset
Dim oDB As DAO.Database
Dim sql As Variant
sql = "SELECT Table1.client, Table1.critere "
sql = sql & "FROM Table1 "
sql = sql & "WHERE (((Table1.critere)='Déces'))"
'Exécution de la requete
Set oDB = CurrentDb
Set oRst = oDB.OpenRecordset(sql, dbOpenSnapshot)
oRst.MoveFirst
While Not oRst.EOF
    Call BoucleTable1(oRst.Fields("client").Value)
    Call SuppressionTable1(oRst.Fields("client").Value)
    oRst.MoveNext
Wend
'On Libération des objets
'Libération des objets
oRst.Close
oDB.Close
Set oRst = Nothing
Set oDB = Nothing
End Sub
 
Public Sub SuppressionTable1(client As String)
Dim oRst As DAO.Recordset
Dim oDB As DAO.Database
Dim sql As Variant
sql = "SELECT Table1.client "
sql = sql & "FROM Table1 "
sql = sql & "WHERE (((Table1.client)='" & client & "'))"
'Exécution de la requete
Set oDB = CurrentDb
Set oRst = oDB.OpenRecordset(sql, dbOpenDynaset)
oRst.MoveFirst
While Not oRst.EOF
    'suppresion de l'enregistrement
    oRst.Delete
    oRst.MoveNext
Wend
'Libération des objets
oRst.Close
oDB.Close
Set oRst = Nothing
Set oDB = Nothing
 
End Sub
 
Public Sub BoucleTable1(client As String)
Dim oRst As DAO.Recordset
Dim oDB As DAO.Database
Dim sql As Variant
sql = "SELECT Table1.client, Table1.critere, Table1.dateNaissance, Table1.dateVisite "
sql = sql & "FROM Table1 "
sql = sql & "WHERE (((Table1.client)='" & client & "'))"
'Exécution de la requete
Set oDB = CurrentDb
Set oRst = oDB.OpenRecordset(sql, dbOpenSnapshot)
oRst.MoveFirst
While Not oRst.EOF
    Call ecritureTable2(oRst.Fields("client").Value, oRst.Fields("critere").Value, oRst.Fields("dateNaissance").Value, oRst.Fields("dateVisite").Value)
    oRst.MoveNext
Wend
'On Libération des objets
'Libération des objets
oRst.Close
oDB.Close
Set oRst = Nothing
Set oDB = Nothing
End Sub
 
Public Sub ecritureTable2(client As String, critere As String, dateNaissance As Date, dateVisite As Date)
Dim oRst As DAO.Recordset
Dim oDB As DAO.Database
Dim sql As Variant
Set oDB = CurrentDb
Set oRst = oDB.OpenRecordset("Table2", dbOpenDynaset)
'Passage en mode ajout
oRst.AddNew
'Ajout des données
oRst.Fields("client").Value = client
oRst.Fields("critere").Value = critere
oRst.Fields("dateNaissance").Value = dateNaissance
oRst.Fields("dateVisite").Value = dateVisite
'Mise à jour
oRst.Update
'Libération des objets
oRst.Close
oDB.Close
Set oRst = Nothing
Set oDB = Nothing
End Sub

Il faut appeler la procédure ClientDeces
A toi d'adapter si besoin.
Fred

[kiki51500]

Bonjour à toi

Merci pour ton aide
Donc après avoir bien galéré du fait de ma non-connaissance du domaine à mettre les vrais noms de champs en concordance, j'ai 3 questions
Mais tout d'abord, bravo car le code proposé fonctionne à merveille.

Pour répondre parfaitement à mon besoin:
- J'aimerai transféré les "lignes "complètes et non juste 4 champs (je dois avoir un total d'une cinquantaine de champs)
- De plus nous avons cherché sans reussir pour le cas ou j'ai des champs vides, pour contourner le probleme, nous avons cree une requete mis ea jour afin de remplir les champs avec une valeur bidon.
-Comment rajouter egalement les autres criteres de reprise (demenagement, deces(fait), ...

Penses tu qu'il te soit possible de modifier ton code dans ce sens

Merci beaucoup

[amelyfred]

Salut ,
J'ai modifier le code.
J'ai ajouté une boucle te permettant de gérer tes 50 champs ou plus.

J'ai ajouté un autre critère (ligne 8). A toi d'essayer d'adapter si besoin avec déménagement,...
A toi de jouer !!!!

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Option Compare Database
Public Sub ClientDeces()
Dim oRst As DAO.Recordset
Dim oDB As DAO.Database
Dim sql As Variant
sql = "SELECT Table1.client, Table1.critere "
sql = sql & "FROM Table1 "
sql = sql & "WHERE (((Table1.critere)='Déces') OR ((Table1.critere)='Autre'))"
'Exécution de la requete
Set oDB = CurrentDb
Set oRst = oDB.OpenRecordset(sql, dbOpenSnapshot)
oRst.MoveFirst
While Not oRst.EOF
    Call BoucleTable1(oRst.Fields("client").Value)
    Call SuppressionTable1(oRst.Fields("client").Value)
    oRst.MoveNext
Wend
'On Libération des objets
'Libération des objets
oRst.Close
oDB.Close
Set oRst = Nothing
Set oDB = Nothing
End Sub
 
Public Sub SuppressionTable1(client As String)
Dim oRst As DAO.Recordset
Dim oDB As DAO.Database
Dim sql As Variant
sql = "SELECT Table1.client "
sql = sql & "FROM Table1 "
sql = sql & "WHERE (((Table1.client)='" & client & "'))"
'Exécution de la requete
Set oDB = CurrentDb
Set oRst = oDB.OpenRecordset(sql, dbOpenDynaset)
oRst.MoveFirst
While Not oRst.EOF
    'suppresion de l'enregistrement
    oRst.Delete
    oRst.MoveNext
Wend
'Libération des objets
oRst.Close
oDB.Close
Set oRst = Nothing
Set oDB = Nothing
 
End Sub
 
Public Sub BoucleTable1(client As String)
Dim oRst As DAO.Recordset
Dim oDB As DAO.Database
Dim sql As Variant
sql = "SELECT Table1.client, Table1.critere, Table1.dateNaissance, Table1.dateVisite "
sql = sql & "FROM Table1 "
sql = sql & "WHERE (((Table1.client)='" & client & "'))"
'Exécution de la requete
Set oDB = CurrentDb
Set oRst = oDB.OpenRecordset(sql, dbOpenSnapshot)
oRst.MoveFirst
While Not oRst.EOF
    Call ecritureTable2(oRst)
    oRst.MoveNext
Wend
'On Libération des objets
'Libération des objets
oRst.Close
oDB.Close
Set oRst = Nothing
Set oDB = Nothing
End Sub
Public Sub ecritureTable2(oRst1 As DAO.Recordset)
Dim strChp As String, i As Integer
Dim oRst2 As DAO.Recordset
Dim oDB As DAO.Database
Set oDB = CurrentDb
Set oRst2 = oDB.OpenRecordset("Table2", dbOpenDynaset)
With oRst2
    .AddNew
    For i = 0 To oRst1.Fields.Count - 1
        strChp = oRst1.Fields(i).Name
        .Fields(strChp) = oRst1(strChp)
    Next
    .Update
End With
'On Libération des objets
'Libération des objets
oRst2.Close
oDB.Close
Set oRst2 = Nothing
Set oDB = Nothing
End Sub

[kiki51500]

Un grand bravo à toi et un grand merci
c'est effectivement ce dont j'avais besoin
Moi qui decouvre le VBA, je mesure l'immensité de mon manque de connaissance... :-)

Nous avions aussi modifié la ligne 8 par

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

sql = sql & "WHERE (((Table1.[Motif reprise])<>'""'))"

et modifié egalement ceci pensant lire la totalité des champs pour les écrire ensuite mais nous bloquions plus loin

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
sql = "SELECT *"
sql = sql & "FROM Table1 "
sql = sql & "WHERE (((Table1.Nomp)='" & Nomp & "'))"

Alors encore merci
et je peux passer en résolu