Discussion :

[Filipozzi]

Bonjour,

j'ai besoin d'aide sur le code ci-dessous, quand je l'active via mon AutoExec, ce dernier me renseigne d'une Erreur d'exécution code 70 => Permission refusée :

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
Public Function SauveJour()
 
    Dim varDernierSauvegarde As Variant, Madate As Date
    Dim JourCourant As Integer, JourSauve As Integer
    Dim strCurrent, strDest As String
 
    JourCourant = Day(Date)
    Madate = Date
    varDernierSauvegarde = DMax("Date_Sauvegarde", "Sauvergarde")
 
    If IsNull(varDernierSauvegarde) Then
        JourSauve = 0
    Else
        JourSauve = Day(varDernierSauvegarde)
    End If
 
    If JourSauve <> JourCourant Then ''premier démarrage du jour--> Sauvegarde
 
 
    strCurrent = CurrentProject.Path & "\MaBDD.accdb"
    strDest = CurrentProject.Path & "\SauvegardesBDD\" & _
          "RptSmp00_Sauve_" & Format(Now, "yyyy mm dd") & ".mdb"
 
    FileCopy strCurrent, strDest
 
 
        CurrentDb.Execute "Insert Into Sauvegarde Values (" _
                  & CDbl(Madate) & ")"
        MsgBox "La sauvegarde journalière a été réalisée", vbInformation
    End If
 
End Function

Merci de votre aide, j'avoue être débutant. Alain

[helas]

Bonjour,
La base étant ouverte tu ne peux pas la copier.
Tu peux créer un programme ou une nouvelle base access qui va copier la base si la sauvegarde n'existe pas, lancer la base et se fermer.

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
 
Function sauvegarde() As Long
    Dim r As Double
    Dim fichierS As String, fichierD As String
 
    fichierS = CurrentProject.Path & "\RptSmp00.mdb"
    fichierD = CurrentProject.Path & "\SauvegardesBDD\RptSmp00_Sauve_" & Format(Now, "yyyy mm dd") & ".mdb"
 
    If Dir(fichierD, vbNormal) = "" Then FileCopy fichierS, fichierD     'copie le fichier s'il n'xiste pas
    r = Shell("msaccess.exe " & fichierS, vbNormalFocus)              'lance la base  RptSmp00.mdb
    Application.Quit
End Function

[Filipozzi]

Bonjour s, merci de ton code et de to aide mais cela ne fonctionne pas, il ne retrouve pas :

Code :

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

  fichierS = CurrentProject.Path & "\RptSmp00.mdb"

Bien à toi et bonne journée. Alain

[helas]

bonjour et pardon,
il fallait lire

Code :

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

1
2
 
fichierS = CurrentProject.Path & "\MaBDD.accdb"