[AC-2007] Retrouver base dorsale et lier tables avec runtime [Résolu]

[Jordywolf]

Bonjour,
je dois distribuer sur un réseau une BDD Access 2007 constituée d'une base dorsale et d'une frontale. Seulement, je n'aurais que le runtime sur le réseau or je dois pouvoir relier les tables à l'installation. Je suis donc a la recherche d'un code VBA qui puisse tester que les liaisons ne sont plus valides et qui m'ouvre une boite de dialogue permettant de repointer sur la base dorsale afin de mettre a jour les liaisons. Ceci devant se produire qu'une fois (la base dorsale ne bougera plus ensuite)
Je n'ai malheureusement pas trouver cela en cherchant sur les forums.
Tout ce que j'ai trouvé était du code qui effaçait les tables liées a chaque ouverture et recréait les liaisons. C'est trop lourd comme code dans mon cas.
Pouvez-vous m'aider?

Merci d'avance

[Thierry85]

Bonjour,

Utilisez le code suivant ( sur l'évènement clic d'un bouton par exemple ) :

Code :

DoCmd.RunCommand acCmdLinkedTableManager

Bon courage

[Jordywolf]

Merci Thierry,

mais quand j'utilise Runcommand avec le runtime, j'ai une erreur et la base plante. Je te livre ce que j'ai fait qui est beaucoup plus lourd mais qui fonctionne avec une base dorsale qui necessite un mot de passe. On peut la deplacer n'importe ou et retrouver les liaisons. Ce n'est certainement pas optimisé pour le moment ni bien documenté mais je viens juste de le finir.

A placer dans un module:

Code :

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
Dim nbTbl As Long
Dim idx As Long
Dim Path As String
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
        MsgBox "La liaison des tables à la base principale doit être mise à jour"
 
        fRefreshLinks
 
    End If
 
    rst.Close
 
    dbs.Close
 
    Set rst = Nothing
 
    Set dbs = Nothing
 
End Function

Code :

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
Sub fRefreshLinks()
Dim strMdp As String
 
    On Error Resume Next
 
    Call Parcourir
 
 
strMdp = InputBox("Veuillez saisir le mot de passe d'accés à la base source", "MOT DE PASSE")
 
 
    For idx = 0 To nbTbl - 1
 
    Set TblDef = dbs.TableDefs(idx)
 
        If TblDef.Connect <> "" Then
 
        TblDef.Connect = "MS Access;pwd=" & strMdp & ";DATABASE=" & Path
 
 
        TblDef.RefreshLink
 
    End If
 
    Next idx
 
If err = 0 Then
 
MsgBox "Les Tables ont été correctement liées", vbInformation + vbOKOnly, "Liaison Table"
 
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
 
X = 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

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Public Sub Parcourir()
 
Dim fd As FileDialog
 
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
 
    Dim vrtSelectedItem As Variant
 
    With fd
 
        If fd.Show = -1 Then
             For Each vrtSelectedItem In .SelectedItems
 
                Path = vrtSelectedItem
 
            Next vrtSelectedItem
 
        Else
        End If
    End With
 
    Set fd = Nothing
End Sub

Merci encore