Discussion :

[Frendy13]

Bonsoir,

j'ai fait face a un problème pour lequel je sollicite votre aide. j'ai scinde une base de données access 2007 en deux: une frontale et une dorsale. Mon souhait est de permettre la mise a jour de liens des tables liées a la base dorsale ou que se trouve cette dernière. En utilisant le code donne ci-dessous, la mise a jour n'est pas réalisée et le message" les tables liées ne sont pas trouvées dans la base source est toujours affiche.

Merci de m'aider.

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
Dim nbTbl As Long
Dim idx As Long
Dim dbs As DAO.Database
Dim TblDef As DAO.TableDef
Function fCheckLinks()
    Dim rst As DAO.Recordset
 
    Set dbs = CurrentDb()
 
    On Error Resume Next
 
    nbTbl = dbs.TableDefs.Count
 
    For idx = 0 To nbTbl - 1
 
        Set TblDef = dbs.TableDefs(idx)
 
        If TblDef.Attributes = dbAttachedTable Then
 
            Set rst = dbs.OpenRecordset(TblDef.Name)
 
        End If
 
    Next idx
 
    If Err <> 0 Then
 
        fRefreshLinks
 
    End If
 
    rst.Close
 
    dbs.Close
 
    Set rst = Nothing
 
    Set dbs = Nothing
 
End Function

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
Sub fRefreshLinks()
 
    Dim newpath As String
 
    On Error Resume Next
 
    newpath = fOpenFile("Choisir la Back-End", , False)
 
    'N'oubliez pas la fonction fOpenFile
 
    For idx = 0 To nbTbl - 1
 
        Set TblDef = dbs.TableDefs(idx)
 
        If TblDef.Connect <> "" Then
 
            TblDef.Connect = ";DATABASE=" & newpath
 
            TblDef.RefreshLink
 
        End If
 
    Next idx
 
    If Err <> 0 Then
 
        MsgBox "Bienvenue !", vbInformation + vbOKOnly, "Welcome !"
        Exit Sub
 
    Else
 
        If MsgBox("Les Tables n'ont pas été trouvées " _
                & "dans la base sélectionnée, voulez-vous essayer à nouveau ?", _
                vbExclamation + vbYesNo, "Sélection non Valide") = vbNo Then
 
            dbs.Close
 
            Set dbs = Nothing
 
            Set TblDef = Nothing
 
            MsgBox "Au Revoir !", vbCritical + vbOKOnly, _
            "Fermeture de l'application"
 
            DoCmd.Quit
 
        Else
 
            dbs.Close
 
            Set dbs = Nothing
 
            Set TblDef = Nothing
 
            Call fCheckLinks
 
            End If
 
    End If
 
End Sub

Merci de m'aider.

[Psychopathe]

Ta manière d'utiliser les exceptions (gestion des erreurs) est originale, mais je pense qu'un "On Error GoTo" serait plus approprié...
Sinon pour ton problème la stratégie que je te propose est de:
- Récupérer le chemin et nom de la base où sont les tables liées.
- Dans la base où les liens doivent être modifiés, il faut parcourir chaque table, récupérer le nom de chaque table, les supprimer, et refaire une attache pour chaque table.
Pas trop compliqué à faire.