Discussion :

[Julie!!!]

Bonjour,

Je n'arrive pas à automatiser la sauvegarde de ma base dorsale

Voilà ce que j'ai écrit :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
 
Dim strCurrent, strDest As Variant
'On indique l'endroit, et quelle base copier
    strCurrent = "D:\BD\ZH\Tables.mdb"
'On indique ou aller copier et sous quel nom
strDest = "D:\BD\ZH\SauveTables.mdb"
'on ferme la base dorsale (je le re-ouvre pour pouvoir recuperer le numéro de fichier)
Dim intFichier As Integer
intFichier = FreeFile
Open strCurrent For Input As intFichier
Close intFichier
'on copie la base
FileCopy strCurrent, strDest

Mais cela ne marche pas, après de nombreux bugs et erreurs (70 : permission refusée), maintenant, ca ne declenche plus rien ... et ca n'a pas l'air de fermer ma base Tables.mdb

Je m'y prends surement mal, ... merci pour toutes suggestions !

Julie

[Invité]

Bonjour

Petite question, pourquoi veux-tu fermer ta base dorsale ?

Philippe

[Julie!!!]

Bonjour Philippe,

Je veux fermer la dorsale car l'aide indique que

"Si vous appliquez l'instruction FileCopy à un fichier ouvert, une erreur se produit."

Julie

[popofpopof]

Pour ma par j'ai mis en place un procédure avec un fichier vbs tout simplement

il me compacte la base me la copier dans un nouveau dossier et me garde les 180 derniere base quand on dépasse les 180 il supprime la plus ancienne

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
'compacte base
 
Dim jro, fso
Dim strBD, strBDCPCT, strBDBAK, ErrNum, ErrDesc, ErrFile
Dim strBDwoExt, strBDext, pos
 
strBD = "D:\aa\bb\ACCESBASESTAGNE\BASETABLE\APPSA.mdb"
 
' Coupe nom complet en nom + extension
pos = InStrRev(strBD, ".")
If pos < 1 Then pos = Len(strBD) + 1
strBDwoExt = Left(strBD, pos - 1)
strBDext = Mid(strBD, pos, Len(strBD) + 1 - pos)
 
' Crée nom base compactée, nom base sauvegardée
strBDCPCT = strBDwoExt & "Cpct" & strBDext
strBDBAK = strBDwoExt & ".bak" & strBDext
 
' Supprime base compactée si existe
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FileExists(strBDCPCT) Then fso.DeleteFile strBDCPCT
 
' Compacte base dans base compactée
Set jro = CreateObject("jro.JetEngine")
ErrNum = 0
On Error Resume Next
' Si mot de passe, ajouter ;Jet OLEDB:Database Password=
' Pour spécifier format base compactée ajouter ;Jet OLEDB:Engine Type=
'	4 pour jet 3.x
'       5 pour Jet 4.0
jro.CompactDatabase "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strBD , _
 		    "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strBDCPCT 
ErrNum = Err.Number: ErrDesc = Err.Description
On Error GoTo 0
 
' Si pas d'erreur renomme base en base sauvegardée
'                 renomme base compactée en base
If ErrNum = 0 Then
   If fso.FileExists(strBDBAK) Then fso.DeleteFile strBDBAK
   fso.MoveFile strBD, strBDBAK
   fso.MoveFile strBDCPCT, strBD
else
   Set ErrFile = fso.CreateTextFile(strBDwoExt & "ERR.txt", True, False)
   ErrFile.Write FormatDateTime(Now, 2) & "  " & FormatDateTime(Now, 3) & _
                 "  Erreur " & CStr(ErrNum) & " : " & ErrDesc
   ErrFile.Close
End If
 
 
 
 
 
 
 
'copier base + efface les plus ancienne
 
Function FileCp (strSourceFile, strTargetFile)
   Const OverwriteExisting = True
   Set objFSO = CreateObject("Scripting.FileSystemObject" )
   If Not objFSO.FileExists(strSourceFile) Then
      MsgBox "Fichier " & strSourceFile & " introuvable", vbExclamation
      Exit Function
   End If
   objFSO.CopyFile strSourceFile , strTargetFile, OverwriteExisting
   Set objFSO = Nothing
 
End Function
 
      FileCp "D:\aa\bb\ACCESBASESTAGNE\BASETABLE\APPSA.mdb", "D:\aa\bb\ACCESBASESTAGNE\BASETABLE\Sauve base journaliere\"& "APPSA "& Right(Date, 4) & " " & Mid(Date,4,2) & " " & Left(Date,2) & ".mdb"
 
 
 
 
Dim Fso2
Dim Directory 
Dim Modified
Dim Files 
Set Fso2 = CreateObject("Scripting.FileSystemObject" )
Set Directory = Fso2.GetFolder("D:\aa\bb\ACCESBASESTAGNE\BASETABLE\Sauve base journaliere" )
Set Files = Directory.Files 
 
For Each Modified in Files
If DateDiff("D", Modified.DateLastModified, Now) > 180 Then Modified.Delete
Next
 
 
 
 
 
'suppression base bak crée pour rien
Dim fso5
 
'instanciation
Set FSO5 = CreateObject("Scripting.FileSystemObject")
 
'Suppression du fichier
Set Ftxt = fso5.GetFile("APPSA.bak.mdb")   'Fichier origine
Ftxt.delete

sa repond a tes question?

[vodiem]

salut à tous,

"Si vous appliquez l'instruction FileCopy à un fichier ouvert, une erreur se produit."

je pensais comme toi, mais il est possible de copier avec fso.CopyFile
tu trouveras dans cette discution sur la sauvegarde automatique un autre code de notre ami francishop.

merci popofpopof pour le tien. je jetterais un oeil dessus car je n'ai pas fini d'étudier la question pour mes besoins.

toutefois Julie!!!, j'ai le souvenir d'avoir réussi à produire: "permission refusée" avec "CopyFile" dans une circonstance très particulière.
pour éviter cela, je n'ai pas trouvé d'autre solution que de faire sauter le partage du fichier. (en envoyant préalablement une notification aux postes concernés)
il est aussi possible de mettre en place une gestion d'erreur et différer la copie.

[francishop]

Bonsoir à tous,

Les demandes semblent similaires, donc même motif, même punition :

http://www.developpez.net/forums/d60...r/#post3749871

Cordialement.

Ps : Un salut particulier à l'ami Vodiem, pour qui les journées semblent démarrer de bonne heure.. Si ce n'est se finir?

[Julie!!!]

Bonjour,

J'ai testé le code de la solution de francishop et ça marche.

Merci à tous

Julie