Discussion :

[docjo]

Bonjour à tous

Au démarrage de ma base, je vérifie si j'ai une version plus récente que celle installée. Je passe par une base intermédiaire que j'appelle par le code suivant:

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
 
Function OpenDB(strDB As String, strForm As String)
 
 
Dim objAccess As Access.Application
Dim lngRet As Long
 
 
    Set objAccess = New Access.Application
        With objAccess
            lngRet = apiSetForegroundWindow(.hWndAccessApp)
            lngRet = apiShowWindow(.hWndAccessApp, SW_NORMAL)
            lngRet = apiShowWindow(.hWndAccessApp, SW_MAXIMIZE)
            .OpenCurrentDatabase strDB
            .DoCmd.OpenForm strForm
        End With
End Function

En mode accdb cela fonctionne nickel mais en mode runtime, j'ai une erreur'2001' et il 'arrête sur .OpenCurrentDatabase strDB
Il me signale que soit la base n'est pas présente soit ce n'est pas un objet ADB.
Merci d'avance pour vos suggestions.

[titi95]

Bonjour

OpenCurrentDatabase qui ne fonctionne pas sous Runtime : "ce serait normal" d'après Microsoft. (pb avec CreateObject ? )

Il faut ouvrir ta base avec Shell.

titi95

[docjo]

Oui, mais je ne sais pas comment ouvrir un formulaire par le shell. et je ne vois pas comment, aprés avoir ouvert la base ouvrir l'un ou l'autre des formulaire selon l'appel d'une autre base.
Je rappele ma procédure: la base s'ouvre (base1). Elle vérifie si la version actuelle est la plus récente. si elle trouve une version plus récente, elle ouvre la base d'échange (Base_Echange) puis se ferme (base1) afin de permettre la copie de la nouvelle à sa place. Puis la base d'échange (base_Echange) se ferme et la nouvelle s'ouvre (base1).
J'avais dans l'idée d'utiliser la même base d'échange pour d'autres bases (Base2). Avec access, pas de problème avec le code du premier post: j'ouvre le formulaire (strForm) de la base (strDB: base1)

Code :

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

1
2
3
 
            .OpenCurrentDatabase strDB
            .DoCmd.OpenForm strForm

Mais ce code ne marche pas avec le runtime.
une équivalence en Shell ?

[titi95]

Un problème après l'autre

En mode accdb cela fonctionne nickel mais en mode runtime, j'ai une erreur'2001' et il 'arrête sur .OpenCurrentDatabase strDB

>>> essaie d'abord d'ouvrir avec le Shell (voir aide sous VBA)

titi95

[docjo]

Cela ne fonctionne pas !

Code :

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

1
2
3
 
    Dim X
    X = Shell("msaccess.exe ""C:\Program Files\RepertoireBase1\Base_Echange.accdr""", vbMaximizedFocus)

Comme je travaille sur un poste qui a Access 2010 et pas le runtime, j'ai essayé cela

Code :

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

1
2
3
4
5
6
7
 
'précise si on ouvre par le runtime
    If SysCmd(acSysCmdRuntime) = True Then
    Shell SysCmd(acSysCmdAccessDir) & "MSAccess.exe  ""C:\Program Files\RepertoireBase1\Base_Echange.accdr"" /runtime", vbNormalFocus
    Else
    Shell SysCmd(acSysCmdAccessDir) & "MSAccess.exe  ""C:\Program Files\RepertoireBase1\Base_Echange.accdr""", vbNormalFocus
    End If

Ce code ouvre bien access mais rien ne se passe.

[titi95]

1) attention à la syntaxe ! (manque des espaces, ...)
2) que l'utilisateur ait Access 2010 ou le Runtime 2010, tu peux appeler avec le même Shell
3) si un utilisateur avait une autre version, il faut obliger à ouvrir dans Office14
ce que j'utilise personnellement :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
Dim CheminExe As String, CheminBase As String, Chemin As String
Dim OuvreBase As Double
Dim ErrNum As Long
On Error GoTo ErrOuverture
CheminExe = Left(SysCmd(acSysCmdAccessDir), Len(SysCmd(acSysCmdAccessDir)) - 3) + "14\MsAccess.exe"
CheminBase = "C:\...\nombase.accdb"   'ou .accde
Chemin = """" & CheminExe & """ """ & CheminBase & """" & " /runtime"
OuvreBase = Shell(Chemin, vbMaximizedFocus)
...
ErrOuverture:
    MsgBox "L'ouverture a échoué !" & vbCr & vbCr & "Erreur No." & err.Number & Chr(10) & err.Description
...

4) Pourquoi tu mets une extension accdr ?
Celle-ci permet de faire des essais sous Access, mais ne protège absolument pas la base. (accdr + /runtime ??? )

titi95

[docjo]

Merci titi pour tes précieux conseils. tout fonctionne à présent pour le mieux.

4) Pourquoi tu mets une extension accdr ?
Celle-ci permet de faire des essais sous Access, mais ne protège absolument pas la base. (accdr + /runtime ??? )

J'ai par le passé posé ces questions afin d'aministrer pour le mieux mes bases (médicales en plus !).
D'une part l'informatique des mon hopital ne m'aide pas du tout à développer et à installer les bases. il faut que je ruse pour détourner les permissions. J'ai quand même réussi à avoir un espace de stockage réseau (sauvegarde de la base dorsale) et à pouvoir installer chaque frontale sur les postes. Mais comme ils fonctionnent sur oracle pour leur logiciel "non médical", ils hésitent à faire cohabiter access 2010. J'ai donc réussi à leur faire accepter le runtime (gratuit !).
Enfin, j'interroge la base régulièrement pour les statistiques de services et je fais évoluer sans cesse l'appli au grès des demandes. Difficile de travailler sur de l'accde sur la dorsale. par contre, accde sur les frontales renommées en accdr.
Je suis preneur bien entendu de tout conseil pour mieux "administrer" la sécurité de ma base.
Dur, dur de bien faire son métier !

Merci encore pour ton aide.

[titi95]

Si je comprends bien, tu veux protéger la dorsale sans la mettre en accde ?
Alors tu la laisses en accdb et tu lui affectes un mot de passe pour l'ouverture.
Après le Shell tu rajoutes :

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
 
    Dim MotPasse As String
    Const Tempo As Single = 10
    Départ = Timer
    Do 'attente ouverture de la boîte de dialogue avant Senkeys
        On Error Resume Next
        AppActivate "Mot de passe requis"
        ErrNum = err.Number
        On Error GoTo ErrOuverture
        DoEvents
        If (Timer - Départ) > Tempo And ErrNum <> 0 Then '
           MsgBox "Temps d'attente écoulé ; erreur " & ErrNum
           GoTo Sortie
        End If
    Loop Until ErrNum = 0
    MotPasse = "toto" 'à renseigner
    SendKeys Nz(MotPasse), True
    SendKeys "{ENTER}"
    SendKeys "{NUMLOCK}" 'si besoin, pour annuler le déverrouillage du pavé numérique réalisé intempestivement par SendKeys Nz(MotPasse)

titi95