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