Boucles de suppression tables nominatives [Résolu]

[@rkane]

bonsoir à tous,

afin d'automatiser mes sauvegardes, j'ai créé 3 boucles

une 1re qui renomme mes tables : tbl.name & "_old"

Une 2eme qui importe les tables recentes

une 3eme qui supprime les tables anciennes renommées en "_old", voici le code :

Code :

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
Progression.Visible = True
Dim db As DAO.Database
Set db = CurrentDb
n = 0
p = 0
'Pour determiner le nombre de tables system
For Each Tbl In db.TableDefs
If (Tbl.Attributes And dbSystemObject) <> 0 Then
n = n + 1
End If
Next Tbl
p = db.TableDefs.Count - 1 - n   ' Pour determiner le nbre de tables non system
Progression.Min = 0
Progression.Max = p
Progression = 0
n = 0
For Each Tbl In db.TableDefs
If (Tbl.Attributes And dbSystemObject) = 0 Then
n = n + 1
 
DoCmd.DeleteObject acTable, Tbl.Name = "*" & "_old"
If n <= p Then
Progression = Progression + 1
End If
End If
Next Tbl

Mon prbleme est d'arriver à supprimer les tables dont le nom se termine par "_old"....

Pour info, la boucle avec la progressbar fonctionne impeccable si je supprime simplement les tbl.name....

Mes remerciements anticipés pour un petit coup de pouce.

[tee_grandbois]

Bonsoir,
tu peux tester la fin du nom de la table:

Code :

1
2
3
4
5
For Each Tbl In db.TableDefs
    If Right(Tbl.Name, 4) = "_old" Then
        db.TableDefs.delete Tbl.Name
    End If
Next

[@rkane]

merci pour ton coup de pouce tee_grandbois, la différenciation se fait bien.
Dans le code ci dessous j'ai laissé les 3 occurrences de filtrage qui fonctionnent...

Néanmoins, il doit y avoir une M.... dans ma boucle car il faut cliquer sur le bouton de suppression à plusieurs reprises pour éliminer les tables en "old".

Même souci en testant sans filtrage sur le nom des tables, elles sont toutes supprimées mais, après de multiples clic sur la commande.

Y a un truc qui m'échappe, parce que le téléchargement des tables depuis la bdd source se fait bien ainsi que l'avancement de la progressbar, idem pour le renommage en "Old_ ****" qui se fait d'un éclair.

C'est très problématique car je comptais activer la procédure en automatique sur le timer.

Code :

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
Private Sub Nettoyer_Click()
Progression.Visible = True
Dim db As DAO.Database
Set db = CurrentDb
n = 0
p = 0
'Pour determiner le nbre de tables systemes
For Each Tbl In db.TableDefs
If (Tbl.Attributes And dbSystemObject) <> 0 Then
n = n + 1
End If
Next Tbl
p = db.TableDefs.Count - 1 - n   ' Pour determiner le nbre de tables non systeme
n = 0
For Each Tbl In db.TableDefs
If (Tbl.Attributes And dbSystemObject) = 0 Then
n = n + 1
 
'If Left(Tbl.Name, 4) = "Old_" Then
'If Left(Tbl.Name, 4) Like "Old_" Then
If Tbl.Name Like "Old_" & "*" Then
 
db.TableDefs.Delete Tbl.Name
 
End If
 
If n <= p Then
End If
End If
Next Tbl
End Sub

[dumas.blr]

Bonjour @rkane,

Je pense qu'un petit coup de

Code :

DoCmd.SetWarnings False

t'aiderait beaucoup ...

[tee_grandbois]

Bonsoir,

il faut cliquer sur le bouton de suppression à plusieurs reprises pour éliminer les tables en "old".

C'est vrai je l'ai constaté: 1 table sur 2 est supprimée à chaque passage, il faut donc lancer plusieurs fois le code de suppression. La solution consisterait à exécuter une boucle tant qu'il exite au moins une table commençant par "old_*". Pourquoi ce comportement ? Cela reste un mystère.

Cela dit, je te propose cet autre code que j'ai testé et qui semble fonctionner.

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
 
Dim db As DAO.Database
Dim rs As DAO.Recordset
Set db = CurrentDb
Set rs = db.OpenRecordset("select Name from MsysObjects where Type =1 and Flags =0 and Name like 'old_*'", dbOpenSnapshot)
 
If rs.RecordCount > 0 Then
    While Not rs.EOF
        DoCmd.DeleteObject acTable, rs.Fields(0)
        Debug.Print rs.Fields(0)
        n = n + 1
        rs.MoveNext
    Wend
End If

[@rkane]

bonsoir tee_grandbois

je me suis repenché ce soir sur mon probleme. Ton code ne fonctionnait pas... Je me suis dit que de toutes façons, puisqu'on filtre sur les noms de table et qu'aucune table systeme ne commence par "old_" je pouvais supprimer cette condition et là ça marche nickel pour la suppression des vieilles tables.
Juste un petit souci avec la progressbar qui m'affiche ça : "invalid property value" lorsque le balayage est terminé.

voici le code de la boucle de suppression :

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Dim db As DAO.Database
Dim rs As DAO.Recordset
n = 0
Progression = 0
Set db = CurrentDb
Set rs = db.OpenRecordset("select Name from MsysObjects where Name like 'old_*'", dbOpenSnapshot)
If rs.RecordCount > 0 Then
While Not rs.EOF
DoCmd.DeleteObject acTable, rs.Fields(0)
Debug.Print rs.Fields(0)
n = n + 1
rs.MoveNext
Progression = n   ' <== ERREUR ICI A LA FIN
Wend
End If

[tee_grandbois]

Bonsoir @rkane,
tu n'as pas précisé ta version d'Access, le code que je t'ai fourni fonctionne avec Access 2003.
En ce qui concerne ton problème de progressbar, je ne peux pas beaucoup t'aider si je n'ai pas plus d'infos. Peut-être as-tu dépassé la valeur max ?

[@rkane]

Yep

C'est good l'ami !

Pour info je tourne sous Access 2003, voilà j'ai résolu cette histoire de boucle, je n'ai plus qu'à tester ça sur le timer pour que ça fonctionne en mode automatique.

Code :

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
Dim db As DAO.Database
Dim rs As DAO.Recordset
Set db = CurrentDb
p = 0
For Each Tbl In db.TableDefs
If Left(Tbl.Name, 4) = "Old_" Then
p = p + 1
End If
Next Tbl
Progression.max = p
n = 0
Set rs = db.OpenRecordset("select Name from MsysObjects where Name like 'old_*'", dbOpenSnapshot)
If rs.RecordCount > 0 Then
While Not rs.EOF
DoCmd.DeleteObject acTable, rs.Fields(0)
Debug.Print rs.Fields(0)
n = n + 1
rs.MoveNext
Progression = n
If Progression = p Then
Undo
DoCmd.Close
End If
Wend
End If

[tee_grandbois]

Super !
2 choses encore:
1) tu peux enlever l'instruction

Code :

Debug.Print rs.Fields(0

c'était pour tester.
2) Vérifie que p et rs.RecordCount ont la même valeur, car il se peut que ton problème de progressbar vienne de là: en effet, dans la collection TableDefs il est possible que tes tables renommées soient stockées dans des objets temporaires d'Access et qu'elles ne soient pas vues par l'application au moment où tu veux les supprimer.

[@rkane]

bon ben voilà, probleme resolu, j'ai placé sur le timer et ça fonctionne nickel.

Je laisse le code complet ça peut depanner un autre membre du forum.

Code :

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
    Private Sub Form_Timer()
 
  Horloge = Now()
 
  If Horloge > DernierBackup + #2:00:00 AM# Then
 
  '  RENOMMAGE DES TABLES EN OLD_***  
  Progression.Visible = True
  Set db = CurrentDb
  n = 0
  p = 0
  'Pour determiner le nbre de tables systemes
  For Each Tbl In db.TableDefs
  If (Tbl.Attributes And dbSystemObject) <> 0 Then
  n = n + 1
  End If
  Next Tbl
  p = db.TableDefs.Count - 1 - n   ' Pour determiner le nbre de tables non systeme
  Progression.Min = 0
  Progression.Max = p
  Progression = 0
  n = 0
  For Each Tbl In db.TableDefs
  If (Tbl.Attributes And dbSystemObject) = 0 And Tbl.Name <> "HistoriquesBackup" Then
  n = n + 1
  DoCmd.Rename "Old_" & Tbl.Name, acTable, Tbl.Name
  If n <= p Then
  Progression = Progression + 1
  End If
  End If
  Next Tbl
  Progression = 0
 
  ' CHARGEMENT DES TABLES NEWS 
 
  Set db = OpenDatabase("H:\DOSSIER_DE_LA_ BASE_DE_DONNEES\MA_BASE_DE_DONNEES.MDE")
  n = 0
  p = 0
  'Pour determiner le nbre de tables systemes
  For Each Tbl In db.TableDefs
  If (Tbl.Attributes And dbSystemObject) <> 0 Then
  n = n + 1
  End If
  Next Tbl
  p = db.TableDefs.Count - 1 - n   ' Pour determiner le nbre de tables non systeme
  Progression.Min = 0
  Progression.Max = p
  Progression = 0
  n = 0
  For Each Tbl In db.TableDefs
  If (Tbl.Attributes And dbSystemObject) = 0 Then
  n = n + 1
  DoCmd.TransferDatabase acImport, "Microsoft Access", "H:\DOSSIER_DE_LA_ BASE_DE_DONNEES\MA_BASE_DE_DONNEES.MDE", acTable, Tbl.Name, Tbl.Name
  If n <= p Then
  Progression = Progression + 1
  End If
  End If
  Next Tbl
  Progression = 0
 
  '  SUPRRESSION DES TABLES OLD 
  Set db = CurrentDb
  p = 0
  For Each Tbl In db.TableDefs
  If Left(Tbl.Name, 4) = "Old_" Then
  p = p + 1
  End If
  Next Tbl
  Progression.Max = p
  n = 0
  Set rs = db.OpenRecordset("select Name from MsysObjects where Name like 'Old_*'", dbOpenSnapshot)
  If rs.RecordCount > 0 Then
  While Not rs.EOF
  DoCmd.DeleteObject acTable, rs.Fields(0)
  n = n + 1
  rs.MoveNext
  Progression = n
  If Progression = p Then
  Undo
  End If
  Wend
  End If
 
  sql = "INSERT INTO HistoriquesBackup ( DateBKP ) SELECT Now() ;"
  DoCmd.RunSQL sql
 
  DoCmd.DeleteObject acTable, "HistoriquesBackup1"
 
  ProchainBackup = DernierBackup + #2:00:00 AM#
 
  Form.Requery
  End If
End Sub