Bonjour,

Je me suis servi de cette discussion car je me trouvais dans le même cas de figure que MsnSylvain.

Cela fonctionne parfaitement jusqu'au moment ou j'ai ajouté de nouvelles tables liées mais provenant d'un .mdb différent de celui renfermant les tables utilisées jusqu'à maintenant.

J'ai essayé de m'en sortir par plusieurs manip mais en vain. Voici l'état actuel de mon code :

Formulaire de démarrage (sur ouverture) :

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
Private Sub Form_Open(Cancel As Integer)
 
Dim strTLPrometheeReseau As String
Dim strTLPrometheeLocal As String
Dim strTLDaedalusReseau As String
Dim strTLDaedalusLocal As String
Dim intChoix As Integer
 
retour:
strTLPrometheeReseau = ""
strTLPrometheeLocal = ""
strTLDaedalusReseau = ""
strTLDaedalusLocal = ""
 
On Error Resume Next
 
strTLPrometheeReseau = Dir("\\CBEHOM58\tlebouvi$\Mes documents\TLAtlantis\Réseau\testcode.mdb")
strTLPrometheeLocal = Dir("\\CBEHOM58\tlebouvi$\Mes documents\TLAtlantis\Local\testcode.mdb")
strTLDaedalusReseau = Dir("\\CBEHOM58\tlebouvi$\Mes documents\TLAtlantis\Réseau\BdMultiCritere.mdb")
strTLDaedalusLocal = Dir("\\CBEHOM58\tlebouvi$\Mes documents\TLAtlantis\Local\BdMultiCritere.mdb")
 
On Error GoTo 0
 
If strTLPrometheeReseau <> "" Then
   TLPrometheeReseau
   TLDaedalusReseau
Else
   intChoix = MsgBox("La base réseau ne peut être jointe. Vérifier votre connexion réseau. Cliquez sur Oui pour réessayer, sur non pour vous connecter à une base locales (pour maintenance seulement) ou sur annuler pour abandonner", vbYesNoCancel, "Avertissement connexion:")
   If intChoix = vbYes Then
      GoTo retour
   ElseIf intChoix = vbCancel Then
      DoCmd.Close
   Else
      If strTLPrometheeLocal <> "" Then
         TLPrometheeLocal
         TLDaedalusLocal
      Else
         MsgBox "Aucune Base disponible, réessayer lorsque le réseau sera connecté"
 
      End If
 
   End If
End If
 
End Sub
et modules de code :

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
Option Compare Database
 
Function fRediriger_donnees(arg_chemin As String) As Boolean
 
 
    Dim Var As Variant
    Dim I As Integer
    Dim Tdf As TableDef
    Dim Db As Database
 
 
    On Error GoTo fRediriger_donnees_Exit
 
 
    fRediriger_donnees = False
    Set Db = CurrentDb
    Var = SysCmd(SYSCMD_INITMETER, "Patientez !!! Réorganisation en cours des données...", Db.TableDefs.Count)
    For I = 0 To Db.TableDefs.Count - 1
        Set Tdf = Db.TableDefs(I)
        If Tdf.Connect & "" <> "" Then 'la table est attachée
            Tdf.Connect = ";DATABASE=" & arg_chemin
            Tdf.Refreshlink
        End If
        Set Tdf = Nothing
        Var = SysCmd(SYSCMD_UPDATEMETER, I)
    Next I
    fRediriger_donnees = True
 
 
fRediriger_donnees_Exit:
    Var = SysCmd(SYSCMD_REMOVEMETER)
    Set Db = Nothing
    Set Tdf = Nothing
    Exit Function
 
fRediriger_donnees_Error:
    fRediriger_donnees = False
    GoTo fRediriger_donnees_Exit
 
End Function
 
Sub TLPrometheeLocal()
fRediriger_donnees ("\\CBEHOM58\tlebouvi$\Mes documents\TLAtlantis\Local\testcode.mdb")
End Sub
Sub TLPrometheeReseau()
fRediriger_donnees ("\\CBEHOM58\tlebouvi$\Mes documents\TLAtlantis\Réseau\testcode.mdb")
End Sub
Sub TLDaedalusLocal()
fRediriger_donnees ("\\CBEHOM58\tlebouvi$\Mes documents\TLAtlantis\Local\BdMultiCritere.mdb")
End Sub
Sub TLDaedalusReseau()
fRediriger_donnees ("\\CBEHOM58\tlebouvi$\Mes documents\TLAtlantis\Réseau\BdMultiCritere.mdb")
End Sub
mais je manque de connaissance en VBA (grammaire ET dictionnaire).

Quelqu'un peut'il me mettre sur la voie SVP.
Merci d'avance.