Problème mise en place de recordset

**Almeyric** · 08/03/2016, 21h17

Bonsoir,

Je désire archiver les données d'une table vers une table archives suivant certains critères. Le code ci-dessous fonctionne mais je n'arrive pas à récupérer le nombre de lignes archivées.

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
Private Sub Archiver_Accueillis_Click()
 
Dim Message1, Style1, Titre1
Dim Message2, Style2, Titre2
Dim Message3, Style3, Titre3
Dim Nb_Archives As Variant, Tbl As String
 
Tbl = "Archives_Accueillis_Simples"
 
'Msgbox Ok + Non
Message1 = "Vous êtes sur le point d'archiver les accueillis, cette opération est irréversible." & vbLf & vbLf & "Veuillez être sûre que toutes les conditions pour l'archivage soient renseigner sur les fiches détails de l'accueilli. (Date de sortie et Motif de Sortie)." & vbLf & vbLf & "Pour archiver, cliquez sur OUI sinon cliquez sur NON."
Style1 = vbYesNo
Titre1 = "Procédure d'archivage"
'MsgBox Message1, Style1, Titre1
Select Case MsgBox(Message1, Style1, Titre1)
 
Case vbYes
'procédure si click sur Ok
    DoCmd.SetWarnings False
    'On sélectionne les accueillis correspondant aux critères d'archivages
    DoCmd.OpenQuery "R_Archives_Accueillis_Select", acViewNormal, acAdd
    'Nb_Archives = DCount("*", "R_Archives_Accueillis_Select")
 
    'On supprime la sélection de la table d'Accueilli
    DoCmd.OpenQuery "R_Suppression_Accueillis_Archives", acViewNormal, acEdit
 
    Message2 = "L'archivage est terminé." & vbLf & vbLf & "Il y a eu " & Nb_Archives & " accueillis d'archivé. Vous les retrouverez sur la liste des archives."
    Style2 = vbOKOnly
    Titre2 = "Archivage terminé"
    MsgBox Message2, Style2, Titre2
    DoCmd.SetWarnings True
 
Case vbNo
'procédure si click sur Non
    Message3 = "L'archivage est annulé."
    Style3 = vbOKOnly
    Titre3 = "Archivage Annulé par l'utilisateur"
    MsgBox Message3, Style3, Titre3
 
End Select
End Sub

Donc j'ai transposé en SQL, mais là je n'arrive pas à exécuter mon select puisque execute n'est pas permis. J'ai compris qu'il fallait travailler avec recordset mais j'ai du mal à l'appliquer.

Voici mon code :

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
Private Sub Archiver_Accueillis_SQL_Click()
 
Dim Message1, Style1, Titre1
Dim Message2, Style2, Titre2
Dim Message3, Style3, Titre3
 
'Msgbox Ok + Non
Message1 = "Vous êtes sur le point d'archiver les accueillis, cette opération est irréversible." & vbLf & vbLf & "Veuillez être sûre que toutes les conditions pour l'archivage soient renseigner sur les fiches détails de l'accueilli. (Date de sortie et Motif de Sortie)." & vbLf & vbLf & "Pour archiver, cliquez sur OUI sinon cliquez sur NON."
Style1 = vbYesNo
Titre1 = "Procédure d'archivage"
'MsgBox Message1, Style1, Titre1
Select Case MsgBox(Message1, Style1, Titre1)
 
Case vbYes
'procédure si click sur Ok
    DoCmd.SetWarnings False
 
    Dim Tbl As String, Tbl2 As String, Motif_Sortie As String, rs As DAO.Recordset
    Dim db As String
    Dim SQL As String
    Dim Nb_Archives As String
 
    db = CurrentDb
    Tbl = "Archives_Accueillis_Simples"
    Tbl2 = "Accueillis Simples"
 
    ' Exécution de la requête
 
    'On sélectionne les accueillis correspondant aux critères d'archivages
    SQL = "SELECT [" & Tbl2 & "].[ID], [" & Tbl2 & "].[ID Accueilli simple],"
    SQL = SQL & "[" & Tbl2 & "].[Civilité],"
    SQL = SQL & "[" & Tbl2 & "].[Prénom], [" & Tbl2 & "].[Nom], [" & Tbl2 & "].[Date de naissance],"
    SQL = SQL & "[" & Tbl2 & "].[Département d'origine], [" & Tbl2 & "].[Date d'entrée],"
    SQL = SQL & "[" & Tbl2 & "].[Date de sortie], [" & Tbl2 & "].[Id_Motif]"
    SQL = SQL & " FROM tbl_Motif_Sortie INNER JOIN [" & Tbl2 & "] ON tbl_Motif_Sortie.Id_Motif = [" & Tbl2 & "].Id_Motif"
    SQL = SQL & " GROUP BY [" & Tbl2 & "].ID, [" & Tbl2 & "].[ID Accueilli simple],"
    SQL = SQL & "[" & Tbl2 & "].Civilité, [" & Tbl2 & "].Prénom, [" & Tbl2 & "].Nom,"
    SQL = SQL & "[" & Tbl2 & "].[Date de naissance], [" & Tbl2 & "].[Date d'entrée],"
    SQL = SQL & "[" & Tbl2 & "].[Date de sortie], [" & Tbl2 & "].Id_Motif"
    SQL = SQL & " HAVING ((([" & Tbl2 & "].[Date de sortie])=True)"
    SQL = SQL & " And ([" & Tbl2 & "].[Id_Motif] Between 1 And 10)) OR (([" & Tbl2 & "].[Id_Motif] Between 1 And 10));"
    CurrentDb.Execute SQL
    Nb_Archives = NbRecords(SQL)
 
    'On ajoute la sélection dans la table d'archives
    CurrentDb.Execute "INSERT INTO" & Tbl & "( ID, [ID Accueilli simple], Civilité, Prénom, Nom, [Date de naissance], [Date d'entrée], [Date de sortie], [Motif de sortie] )"
 
    'On supprime la sélection de la table d'Accueilli
    SQL = "DELETE [" & Tbl2 & "].*, [" & Tbl2 & "].[Date de sortie], [" & Tbl2 & "].Id_Motif FROM " & Tbl2
    SQL = SQL & "WHERE ((([" & Tbl2 & "].[Date de sortie])=True) AND (([" & Tbl2 & "].Id_Motif) Between 1 And 10));"
    db.Execute SQL
 
    Message2 = "L'archivage est terminé." & vbLf & vbLf & "Il y a eu " & Nb_Archives & " accueillis d'archivé. Vous les retrouverez sur la liste des archives."
    Style2 = vbOKOnly
    Titre2 = "Archivage terminé"
    MsgBox Message2, Style2, Titre2
    DoCmd.SetWarnings True
 
Case vbNo
'procédure si click sur Non
    Message3 = "L'archivage est annulé."
    Style3 = vbOKOnly
    Titre3 = "Archivage Annulé par l'utilisateur"
    MsgBox Message3, Style3, Titre3
 
End Select
 
End Sub

**Zekraoui_Jakani** · 09/03/2016, 12h40

Tu peux essayer ceci:

Code :

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

1
2
3
4
5
6
7
8
9
10
11
dim rs as recordset
set rs = currentdb().openrecordset("tbl")
 
with rs
.movefirst
.movelast
Nombre = .recordcount
.close
end with
set rs = Nothing
debug.print "nombre = " & Nombre

**Almeyric** · 09/03/2016, 14h05

Envoyé par Zekraoui_Jakani

Tu peux essayer ceci:

Code :

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

1
2
3
4
5
6
7
8
9
10
11
dim rs as recordset
set rs = currentdb().openrecordset("tbl")
 
with rs
.movefirst
.movelast
Nombre = .recordcount
.close
end with
set rs = Nothing
debug.print "nombre = " & Nombre

Ce ne serai pas plutôt sql que tbl ?

Je vais tester.

**Almeyric** · 09/03/2016, 14h30

J'ai erreur d'exécution 3078 avec SQl et tbl.

J'ai bien mis le code après ma requête sql select.

**madefemere** · 09/03/2016, 14h54

Bonjour,

2 points :

1- Dans le premier code que tu postes dans ton premier message,
Que donne un debug.print à la ligne 23 dans la fenêtre d'exécution :

Code :

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

1
2
Nb_Archives = DCount("*", "R_Archives_Accueillis_Select")
Debug.Print Nb_Archives

Normalement ce code devrait être suffisant.

2- Dans le deuxième code (observations en rouge) :

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
Private Sub Archiver_Accueillis_SQL_Click()
 
Dim Message1, Style1, Titre1
Dim Message2, Style2, Titre2
Dim Message3, Style3, Titre3
 
'Msgbox Ok + Non
Message1 = "Vous êtes sur le point d'archiver les accueillis, cette opération est irréversible." & vbLf & vbLf & "Veuillez être sûre que toutes les conditions pour l'archivage soient renseigner sur les fiches détails de l'accueilli. (Date de sortie et Motif de Sortie)." & vbLf & vbLf & "Pour archiver, cliquez sur OUI sinon cliquez sur NON."
Style1 = vbYesNo
Titre1 = "Procédure d'archivage"
'MsgBox Message1, Style1, Titre1
Select Case MsgBox(Message1, Style1, Titre1)
 
Case vbYes
'procédure si click sur Ok
    DoCmd.SetWarnings False
 
    Dim Tbl As String, Tbl2 As String, Motif_Sortie As String, rs As DAO.Recordset
    Dim db As String
    Dim SQL As String
    Dim Nb_Archives As String
 
    db = CurrentDb
    Tbl = "Archives_Accueillis_Simples"
    Tbl2 = "Accueillis Simples"
 
    ' Exécution de la requête
 
    'On sélectionne les accueillis correspondant aux critères d'archivages
    SQL = "SELECT [" & Tbl2 & "].[ID], [" & Tbl2 & "].[ID Accueilli simple],"
    SQL = SQL & "[" & Tbl2 & "].[Civilité],"
    SQL = SQL & "[" & Tbl2 & "].[Prénom], [" & Tbl2 & "].[Nom], [" & Tbl2 & "].[Date de naissance],"
    SQL = SQL & "[" & Tbl2 & "].[Département d'origine], [" & Tbl2 & "].[Date d'entrée],"
    SQL = SQL & "[" & Tbl2 & "].[Date de sortie], [" & Tbl2 & "].[Id_Motif]"
    SQL = SQL & " FROM tbl_Motif_Sortie INNER JOIN [" & Tbl2 & "] ON tbl_Motif_Sortie.Id_Motif = [" & Tbl2 & "].Id_Motif"
    SQL = SQL & " GROUP BY [" & Tbl2 & "].ID, [" & Tbl2 & "].[ID Accueilli simple],"
    SQL = SQL & "[" & Tbl2 & "].Civilité, [" & Tbl2 & "].Prénom, [" & Tbl2 & "].Nom,"
    SQL = SQL & "[" & Tbl2 & "].[Date de naissance], [" & Tbl2 & "].[Date d'entrée],"
    SQL = SQL & "[" & Tbl2 & "].[Date de sortie], [" & Tbl2 & "].Id_Motif"
    SQL = SQL & " HAVING ((([" & Tbl2 & "].[Date de sortie])=True)"
    SQL = SQL & " And ([" & Tbl2 & "].[Id_Motif] Between 1 And 10)) OR (([" & Tbl2 & "].[Id_Motif] Between 1 And 10));"
    CurrentDb.Execute SQL  ' TU FAIS UNE REQUETE SELECTION DONC NORMAL SI ON N'UTILISE PAS EXECUTE 
    ' JE NE COMPRENDS PAS L'UTILITE DE LA LIGNE DE CODE PRECEDENTE
    Nb_Archives = NbRecords(SQL)
 
    'On ajoute la sélection dans la table d'archives
    CurrentDb.Execute "INSERT INTO" & Tbl & "( ID, [ID Accueilli simple], Civilité, Prénom, Nom, [Date de naissance], [Date d'entrée], [Date de sortie], [Motif de sortie] )"
 ' LA LIGNE DE CODE PRECEDETE EST INCOMPLETE PARCE QUE LES VALEURS A AJOUTER NE SONT PAS DEFINIES DANS LE CODE
    'On supprime la sélection de la table d'Accueilli
    SQL = "DELETE [" & Tbl2 & "].*, [" & Tbl2 & "].[Date de sortie], [" & Tbl2 & "].Id_Motif FROM " & Tbl2
    SQL = SQL & "WHERE ((([" & Tbl2 & "].[Date de sortie])=True) AND (([" & Tbl2 & "].Id_Motif) Between 1 And 10));"
    db.Execute SQL
 
    Message2 = "L'archivage est terminé." & vbLf & vbLf & "Il y a eu " & Nb_Archives & " accueillis d'archivé. Vous les retrouverez sur la liste des archives."
    Style2 = vbOKOnly
    Titre2 = "Archivage terminé"
    MsgBox Message2, Style2, Titre2
    DoCmd.SetWarnings True
 
Case vbNo
'procédure si click sur Non
    Message3 = "L'archivage est annulé."
    Style3 = vbOKOnly
    Titre3 = "Archivage Annulé par l'utilisateur"
    MsgBox Message3, Style3, Titre3
 
End Select
 
End Sub

Cordialement,

**Almeyric** · 09/03/2016, 15h27

Envoyé par madefemere

Bonjour,

2 points :

1- Dans le premier code que tu postes dans ton premier message,
Que donne un debug.print à la ligne 23 dans la fenêtre d'exécution :

Code :

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

1
2
Nb_Archives = DCount("*", "R_Archives_Accueillis_Select")
Debug.Print Nb_Archives

Normalement ce code devrait être suffisant.

Oui, il est suffisant si je ne fait qu'un select. Mais j'ai rajouté l'insert que l'on trouve dans le deuxième code en SQL. Donc je me retrouve avec une erreur d'exécution 3147 "une requête action ne peut pas être utilisé comme contenu.

Réponse en vert :

Envoyé par madefemere

2- Dans le deuxième code (observations en rouge) :

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
Private Sub Archiver_Accueillis_SQL_Click()
 
Dim Message1, Style1, Titre1
Dim Message2, Style2, Titre2
Dim Message3, Style3, Titre3
 
'Msgbox Ok + Non
Message1 = "Vous êtes sur le point d'archiver les accueillis, cette opération est irréversible." & vbLf & vbLf & "Veuillez être sûre que toutes les conditions pour l'archivage soient renseigner sur les fiches détails de l'accueilli. (Date de sortie et Motif de Sortie)." & vbLf & vbLf & "Pour archiver, cliquez sur OUI sinon cliquez sur NON."
Style1 = vbYesNo
Titre1 = "Procédure d'archivage"
'MsgBox Message1, Style1, Titre1
Select Case MsgBox(Message1, Style1, Titre1)
 
Case vbYes
'procédure si click sur Ok
    DoCmd.SetWarnings False
 
    Dim Tbl As String, Tbl2 As String, Motif_Sortie As String, rs As DAO.Recordset
    Dim db As String
    Dim SQL As String
    Dim Nb_Archives As String
 
    db = CurrentDb
    Tbl = "Archives_Accueillis_Simples"
    Tbl2 = "Accueillis Simples"
 
    ' Exécution de la requête
 
    'On sélectionne les accueillis correspondant aux critères d'archivages
    SQL = "SELECT [" & Tbl2 & "].[ID], [" & Tbl2 & "].[ID Accueilli simple],"
    SQL = SQL & "[" & Tbl2 & "].[Civilité],"
    SQL = SQL & "[" & Tbl2 & "].[Prénom], [" & Tbl2 & "].[Nom], [" & Tbl2 & "].[Date de naissance],"
    SQL = SQL & "[" & Tbl2 & "].[Département d'origine], [" & Tbl2 & "].[Date d'entrée],"
    SQL = SQL & "[" & Tbl2 & "].[Date de sortie], [" & Tbl2 & "].[Id_Motif]"
    SQL = SQL & " FROM tbl_Motif_Sortie INNER JOIN [" & Tbl2 & "] ON tbl_Motif_Sortie.Id_Motif = [" & Tbl2 & "].Id_Motif"
    SQL = SQL & " GROUP BY [" & Tbl2 & "].ID, [" & Tbl2 & "].[ID Accueilli simple],"
    SQL = SQL & "[" & Tbl2 & "].Civilité, [" & Tbl2 & "].Prénom, [" & Tbl2 & "].Nom,"
    SQL = SQL & "[" & Tbl2 & "].[Date de naissance], [" & Tbl2 & "].[Date d'entrée],"
    SQL = SQL & "[" & Tbl2 & "].[Date de sortie], [" & Tbl2 & "].Id_Motif"
    SQL = SQL & " HAVING ((([" & Tbl2 & "].[Date de sortie])=True)"
    SQL = SQL & " And ([" & Tbl2 & "].[Id_Motif] Between 1 And 10)) OR (([" & Tbl2 & "].[Id_Motif] Between 1 And 10));"
    CurrentDb.Execute SQL  ' TU FAIS UNE REQUETE SELECTION DONC NORMAL SI ON N'UTILISE PAS EXECUTE 
    ' JE NE COMPRENDS PAS L'UTILITE DE LA LIGNE DE CODE PRECEDENTE Je sélectionne les lignes ou la date de sortie n'est pas vide ainsi que le motif de sortie. Il y a 10 motifs de sorties dans la table Motif_Sortie. Si les deux conditions sont réunies, on archive.
    Nb_Archives = NbRecords(SQL)
 
    'On ajoute la sélection dans la table d'archives
    CurrentDb.Execute "INSERT INTO" & Tbl & "( ID, [ID Accueilli simple], Civilité, Prénom, Nom, [Date de naissance], [Date d'entrée], [Date de sortie], [Motif de sortie] )"
 ' LA LIGNE DE CODE PRECEDETE EST INCOMPLETE PARCE QUE LES VALEURS A AJOUTER NE SONT PAS DEFINIES DANS LE CODE En effet, maintenant je comprend pourquoi l'assitant requete ajout rajoute le insert avec la selection...

    'On supprime la sélection de la table d'Accueilli
    SQL = "DELETE [" & Tbl2 & "].*, [" & Tbl2 & "].[Date de sortie], [" & Tbl2 & "].Id_Motif FROM " & Tbl2
    SQL = SQL & "WHERE ((([" & Tbl2 & "].[Date de sortie])=True) AND (([" & Tbl2 & "].Id_Motif) Between 1 And 10));"
    db.Execute SQL
 
    Message2 = "L'archivage est terminé." & vbLf & vbLf & "Il y a eu " & Nb_Archives & " accueillis d'archivé. Vous les retrouverez sur la liste des archives."
    Style2 = vbOKOnly
    Titre2 = "Archivage terminé"
    MsgBox Message2, Style2, Titre2
    DoCmd.SetWarnings True
 
Case vbNo
'procédure si click sur Non
    Message3 = "L'archivage est annulé."
    Style3 = vbOKOnly
    Titre3 = "Archivage Annulé par l'utilisateur"
    MsgBox Message3, Style3, Titre3
 
End Select
 
End Sub

Cordialement,

Merci pour votre aide.

Problème mise en place de recordset

VBA Access

Vue hybride

Discussions similaires

Partager

Partager