Discussion :

[popofpopof]

bonjour

j'ai récuperai le code suivant dans le FAQ et je l'ai un peu modifier.
Je souhaite avertir l'utilisateur qu'il est déconnecte de la base avant de fermer la base donc j'ai fait sa sur un formulaire ouvert a l'ouverture de la base et qui est cache :

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
On Error GoTo Err_LogOffChk
Dim Lancer As Boolean
Dim rcd As DAO.Recordset
Set rcd = CurrentDb.OpenRecordset("tblAdmin")
rcd.MoveFirst
Lancer = rcd.Fields(0)
rcd.Close
CurrentDb.Close
If Lancer Then MsgBox "Vous avez été déconnecté par l'administrateur pour cause de maintenance Merci de reouvrir la base"
If Lancer Then Application.Quit acQuitSaveAll
Exit_LogOff:
   Exit Sub
Err_LogOffChk:
   MsgBox Err.Number & vbCrLf & Err.Description, vbInformation, "Erreur"
   Resume Exit_LogOff

Mon code marche mais j'ai un petit probléme.
Un méssage est donc bien dis a l'utilisateur mais il faut que l'utilisateur clique sur ok pour qu'il soit vraiement déconnécte.
Alors que moi je souhaite que sa soit dans cette ordre :
on déconnecte l'utilisateur
une message informe l'utilisateur
et enfin il clique sur le message OK et la la base ce ferme.

donc mon probléme est la mais je ne sais comment y résourdre

Code :

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

1
2
If Lancer Then MsgBox "Vous avez été déconnecté par l'administrateur pour cause de maintenance Merci de reouvrir la base"
If Lancer Then Application.Quit acQuitSaveAll

je souhaite déconnecte les utilisateur pour faire mes modif sur la base Dorsale donc il ne faut personne de connécte, mais je veux que sur l'ecran des utilisateur un message leur soit affiche.

[DamKre]

Essaie ceci :

Code :

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

1
2
If Lancer Then Application.Quit acQuitSaveAll
If Lancer Then MsgBox "Vous avez été déconnecté par l'administrateur pour cause de maintenance Merci de reouvrir la base"

[popofpopof]

non sa ne marche pas

sa me ferme access et je n'ai même pas le message qui s'affiche.

[Chtulus]

Bonsoir,

re @popofpopof

Bon, il y a bien une solution mais c'est barbare... Avec un formulaire invisible, tu appel un fichier .TXT ou autre qui précise la nature (Le pourquoi du comment !) de la fermeture d'Access.

Tu appel le fichier sur l'action fermeture du formulaire invisible. Dès lors, lorsqu'Access va se fermer, le formulaire va se fermer et l'action de fermeture va s'exécuter et ton utilisateur sera au courant !

Bon je sais je sors...
Je continue mes investigations demain.

@+ @popofpopof

[popofpopof]

c'est un peu trop barbare lol

j'aimerai garde en arriéré plan access pour ne pas perturbé les utilisateurs.

[Pierre Fauconnier]

Bonjour

Je pense qu'il n'est pas possible de garder Access ouvert sans base de données ouverte...

[DamKre]

non sa ne marche pas

sa me ferme access et je n'ai même pas le message qui s'affiche.

Toutes mes excuses, alors...
Personnellement, j'avais une procédure similaire, et, chez moi, ça allait...

[popofpopof]

j'ai trouve je laisse pour les prochain le code complet avec gestion mise en maintenance, fermeture la nuit et mise a jour automatique

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
Private Sub Form_Current()
    'Lors de l'activation de l'enregistrement,
    '      les paramètres par défaut son générés
    Me.TimerInterval = Me.prmScannTimer * 1000
End Sub
 
Private Sub Form_Open(Cancel As Integer)
If VersionNo - NoVersion <> 0 Then
'mise a jour du fichier vbs avant copier de la nouvelle base
  Dim oFSO As Scripting.FileSystemObject
Dim source As String, destination As String
Set oFSO = New Scripting.FileSystemObject
source = "\\Srv_3dmanager\3D_Informatique\ACCESBASE3D\mise a jour base\mise_a_jour_auto.vbs"
destination = "C:\access_pc3d\mise_a_jour_auto.vbs"
oFSO.CopyFile source, destination, True
 
    MsgBox "Une mise à jour de la base est disponible merci de cliquer sur ok la base va se mettre à jour"
 
    Shell "wscript " & "C:\access_pc3d\mise_a_jour_auto.vbs" & """"
    Application.Quit
Else
Set rsAlwaysOpen = CurrentDb.OpenRecordset("tbldummy")
End If
End Sub
 
Private Sub Form_Timer()
 
    'ATTENTION : Les infos de la table sont en Secondes
    '            Les infos attendues en millisecondes.
    '            Penser à toujours multiplier par 1000 !
    '
    '
    'Sur le timer ...
    'Si l'heure limite est passée ...
    If TimeValue(Now()) >= TimeValue(Me.prmShutDownAt) And TimeValue(Now()) <= TimeValue(Me.prmShutDownlimite) Then
        'Si l'intervalle a déjà été remis à l'affichage
        If Me.TimerInterval = Me.prmShowTimer.Value * 1000 Then
            'Alors, quitter l'appli
     Shell "wscript " & "C:\access_pc3d\maintenance.vbs" & """"
            Application.Quit acQuitSaveAll
 
        'Sinon,
        Else
            'mettre l'intervalle d'affichage
            'Et afficher le formulaire
            Me.TimerInterval = Me.prmShowTimer.Value * 1000
            Me.Visible = True
 
        End If
    'Sinon,
    Else
        'Rendre de toutes façons le formulaire invisible
 
    If VerrouAdmin = False Then
 Me.Requery
 If VerrouAdmin = True Then
 fermeture
 End If
Else
fermeture
End If
    End If
End Sub
 
Sub fermeture()
        If Me.TimerInterval = Me.prmShowTimer.Value * 1000 Then
            'Alors, quitter l'appli
     Shell "wscript " & "C:\access_pc3d\maintenance.vbs" & """"
            Application.Quit acQuitSaveAll
 
        'Sinon,
        Else
            'mettre l'intervalle d'affichage
            'Et afficher le formulaire
            Me.TimerInterval = Me.prmShowTimer.Value * 1000
            Me.Visible = True
 
        End If
End Sub