Point de restauration

**MONANGE** · 25/12/2023, 11h39

Bonjours,
Est il possible de lancer un "point de restauration de mon appli Access " à partir d'un formulaire
Si oui : Pouvez vous me mettre sur la voie
merci
Bonnes fêtes

**User** · 25/12/2023, 17h29

Bonsoir et bonnes fêtes

Quel est le but exact de cette manœuvre ?

Si vous souhaitez seulement récupérer une sauvegarde réalisée à une date précise, alors le principe c'est :

Une table pour enregistrer les points de sauvegarde/restauration, avec une date/heure, et un identifiant, ...

Sauvegarde des données de la base dans des tables dédiées qui contiennent les données du fichier Access à une date précise avec en plus l'identifiant du point de sauvegarde :

T_Factures_sauv, T_Detail_Factures_sauv, etc..

Cdlt

**MONANGE** · 26/12/2023, 17h27

Merci pour votre réponse
je vais essayer de mettre en place une sauvegarde en suivant votre conseil premier
Bonne fêtes

**User** · 27/12/2023, 10h14

Bonjour,

Pour faciliter les choses voici un module contenant les 2 fonctions permettant de sauvegarder et de restaurer les données à une date précise :

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
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
Option Compare Database
Option Explicit
 
Function table_existe(nom_table) As Boolean
    Dim dbs As DAO.Database, tb As DAO.TableDef
 
    Set dbs = CurrentDb
 
    table_existe = False
 
    For Each tb In dbs.TableDefs
        If tb.Name = nom_table Then
            table_existe = True
            Exit For
        End If
    Next
 
    Set tb = Nothing
 
    Set dbs = Nothing
 
End Function
 
Function relation_existe(nom_table1, nom_table2) As Boolean
    Dim dbs As DAO.Database, rel As DAO.Relation
 
    Set dbs = CurrentDb
 
    relation_existe = False
 
    For Each rel In dbs.Relations
        If rel.Name = nom_table1 & "_" & nom_table2 Then
            relation_existe = True
            Exit For
        End If
    Next
 
    Set rel = Nothing
 
    Set dbs = Nothing
 
End Function
 
Private Function liste_champs(nom_table) As String
    Dim dbs As DAO.Database, tdf As DAO.TableDef, fld As DAO.Field
 
    Set dbs = CurrentDb
 
    Set tdf = dbs.TableDefs(nom_table)
 
    liste_champs = ""
 
    For Each fld In tdf.Fields
        liste_champs = liste_champs & fld.Name & ", "
    Next
 
    liste_champs = Left(liste_champs, Len(liste_champs) - 2)
 
    Set tdf = Nothing
    Set dbs = Nothing
 
End Function
 
Private Sub creer_relation(nom_table1, nom_champ1, nom_table2, nom_champ2)
    Dim dbs As DAO.Database, rel As DAO.Relation, fld1 As DAO.Field
 
    Set dbs = CurrentDb
 
    Set rel = dbs.CreateRelation("relation_sauvegarde", nom_table1, nom_table2, dbRelationDeleteCascade)
 
    With rel
        Set fld1 = .CreateField(nom_champ1)
        fld1.ForeignName = nom_champ2
        .Fields.Append fld1
        .Name = nom_table1 & "_" & nom_table2
    End With
 
    dbs.Relations.Append rel
 
    Set fld1 = Nothing
    Set rel = Nothing
 
    Set dbs = Nothing
 
End Sub
 
 
Public Sub sauvegarder(tables_sources)
    On Error GoTo err_sauvegarder
    Dim dbs As DAO.Database, rst As DAO.Recordset, tdf As DAO.TableDef, id_sauvegarde As Long
    Dim str_sql As String, i As Long, nom_table As String
 
    Set dbs = CurrentDb
 
    If Not table_existe("T_Sauvegarde") Then
        str_sql = "CREATE TABLE T_Sauvegarde (id_sauvegarde COUNTER, Date_Sauvegarde Date, CONSTRAINT [PrimaryKey] PRIMARY KEY ([id_sauvegarde]));"
        dbs.Execute str_sql, dbFailOnError
    End If
 
    Set rst = dbs.OpenRecordset("T_Sauvegarde")
 
    rst.AddNew
    rst!Date_Sauvegarde = Now
    rst.Update
 
    rst.MoveLast
 
    id_sauvegarde = rst!id_sauvegarde
 
    rst.Close
    Set rst = Nothing
 
    For i = LBound(tables_sources) To UBound(tables_sources)
 
        nom_table = tables_sources(i)
 
        If Not table_existe(nom_table & "_sauv") Then
 
            str_sql = "SELECT * INTO " & nom_table & "_sauv FROM " & nom_table & ";"
            dbs.Execute str_sql, dbFailOnError
 
            dbs.Execute "ALTER TABLE " & nom_table & "_sauv" & " ADD COLUMN id_sauvegarde Long", dbFailOnError
 
        Else
 
            str_sql = "INSERT INTO " & nom_table & "_sauv SELECT * FROM " & nom_table & ";"
            dbs.Execute str_sql, dbFailOnError
 
        End If
 
        If Not relation_existe("T_Sauvegarde", nom_table & "_sauv") Then
            creer_relation "T_Sauvegarde", "id_sauvegarde", nom_table & "_sauv", "id_sauvegarde"
        End If
 
        str_sql = "UPDATE " & nom_table & "_sauv SET id_sauvegarde=" & id_sauvegarde & " WHERE IsNull(id_sauvegarde);"
        dbs.Execute str_sql, dbFailOnError
 
    Next i
 
exit_sauvegarder:
    Application.RefreshDatabaseWindow
    Exit Sub
 
err_sauvegarder:
    MsgBox (Err.Description)
    Resume exit_sauvegarder
 
End Sub
 
Public Sub restaurer(id_sauvegarde, tables_sources)
 
    On Error GoTo err_restaurer
 
    Dim dbs As DAO.Database, i As Long, nom_table As String, str_sql As String
 
    Set dbs = CurrentDb
 
    For i = LBound(tables_sources) To UBound(tables_sources)
 
        nom_table = tables_sources(i)
 
        If table_existe(nom_table & "_sauv") Then
 
            str_sql = "DELETE * FROM " & nom_table & ";"
            dbs.Execute str_sql, dbFailOnError
 
            str_sql = "INSERT INTO " & nom_table & " SELECT " & liste_champs(nom_table) & " FROM " & nom_table & "_sauv" & " WHERE id_sauvegarde=" & id_sauvegarde
            dbs.Execute str_sql, dbFailOnError
 
        End If
 
    Next i
 
exit_restaurer:
    Application.RefreshDatabaseWindow
    Exit Sub
 
err_restaurer:
    MsgBox (Err.Description)
    Resume exit_restaurer
 
End Sub
 
Public Function Test()
    Dim tables_sources As Variant
 
    tables_sources = Array("T_Facture", "T_DetailFacture")
 
    sauvegarder tables_sources
    'restaurer 1, tables_sources
 
End Function

A utiliser comme ceci :

Code :

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

1
2
3
4
5
6
7
Dim tables_sources
 
' les noms des tables à sauvegarder/restaurer    
tables_sources = Array("T_Facture", "T_DetailFacture")
 
sauvegarder tables_sources
'restaurer 1, tables_sources

Cdlt,

**MONANGE** · 14/01/2024, 09h58

Bonjours, Veuillez excuser mon retard à répondre à votre aide qui fut rapide
J'ai adapté à ma base et cela correspond bien à ce que je souhaite obtenir
je vous remercie cela va m'être très utile
Cordialement

**MONANGE** · 14/01/2024, 09h59

Bonjours, Veuillez excuser mon retard à répondre à votre aide qui fut rapide
J'ai adapté à ma base et cela correspond bien à ce que je souhaite obtenir
je vous remercie cela va m'être très utile
Merci
Cordialement

**User** · 14/01/2024, 11h13

Envoyé par MONANGE

Bonjours, Veuillez excuser mon retard à répondre à votre aide qui fut rapide
J'ai adapté à ma base et cela correspond bien à ce que je souhaite obtenir
je vous remercie cela va m'être très utile
Merci
Cordialement

Merci, l'age a du bon

Point de restauration [AC-2019]

Access

Discussions similaires

Partager

Partager