Rafraichir des tables liées

**debutente38** · 04/02/2007, 15h08

Bonjour,

j'ai fractionné ma base, donc je me retrouve avec 2 bases, une base "data" ou se trouve mes tables et l'autre au se trouve mes formulaires.....
(donc les tables de ma base sont liée avec les tables de la nouvelle base "data")

Je voudrai savoir si je change l'endroit ou se trouve ma base "data", comment faire pour rafraichir sur un simple click d'un bouton , le rafaraichissement de mes tables liées. Ma base "data" et protetégé bien sur par un mot de passe (tout kom ma premiere base).

Et comment metre les "securité ", si par exemple la table data n'existe plus ou autre....

Merci d'avance .

**LedZeppII** · 04/02/2007, 18h38

Bonjour,

voici un exemple de code pour changer le chemin des tables liées:

Code vb :

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
Sub RfshLinkedTables()
Dim db As DAO.Database, tdef As DAO.TableDef
Dim strSceDB As String, strConn As String
Dim ConnParams() As String, varParam As Variant
 
strSceDB = "E:\Mes Documents\Access\COMPTOIR.MDB"
 
Set db = CurrentDb
For Each tdef In db.TableDefs
   If (tdef.Attributes And dbAttachedTable) = dbAttachedTable Then
      ' Nouvelle chaîne de connexion
      strConn = ";"
      ' Récuperer mot de passe si existe
      ConnParams() = Split(tdef.Connect, ";")
      For Each varParam In ConnParams
         If varParam Like "PWD=*" Then
            strConn = strConn & varParam & ";"
         End If
      Next
      ' Ajout chemin vers la base dorsale
      strConn = strConn & "DATABASE=" & strSceDB
      ' rafraichir lien
      tdef.Connect = strConn
      tdef.RefreshLink
   End If
Next
 
End Sub

Dans mon exemple, le lien de toutes les table attachées (liées) est recréé avec "E:\Mes Documents\Access\COMPTOIR.MDB"

Tu as aussi cette discussion sur le sujet, et cet élément de la faq

Bon courage

**LedZeppII** · 04/02/2007, 21h19

Vu que j'ai eu une demande similaire par MP voici une solution plus automatique.

1. Mettre ce code dans un module de code.
Il servira à ouvrir une boîte de dialogue demandant la sélection de la base de données dorsale (qui contient les tables)

Code vb :

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
80
81
82
83
84
Declare Function OpenFile Lib "comdlg32.dll" Alias "GetOpenFileNameA" (of As OPENFILENAME) As Integer
 
Type OPENFILENAME
  lStructSize As Long           'DWORD
  hwndOwner As Long             'HWND
  hInstance As Long             'HINSTANCE
  lpstrFilter As String         'LPCTSTR 
  lpstrCustomFilter As Long     'LPTSTR
  nFilterIndex As Long          'DWORD
  nMaxCustFilter As Long        'DWORD
  lpstrFile As String           'LPTSTR
  nMaxFile As Long              'DWORD
  lpstrFileTitle As String      'LPTSTR
  nMaxFileTitle As Long         'DWORD
  lpstrInitialDir As String     'LPCTSTR
  lpstrTitle As String          'LPCTSTR
  Flags As Long                 'DWORD
  nFileOffset As Integer        'WORD
  nFileExtension As Integer     'WORD
  lpstrDefExt As Long           'LPCTSTR
  lCustData As Long             'DWORD
  lpfnHook As Long              'LPOFNHOOKPROC
  lpTemplateName As Long        'LPCTSTR
End Type
 
Public Function OuvrirFichier(Optional Titre As String = "", _
       Optional Chemin As String = "", Optional fType As String = "") As String
Dim ofn As OPENFILENAME
Dim res As Integer, p As Long
 
 If Chemin = "" Then Chemin = CurrentProject.Path
 If Titre = "" Then Titre = " -- Choisir un fichier --"
 
 ofn.lStructSize = Len(ofn)
 ofn.hwndOwner = Application.hWndAccessApp
 ofn.hInstance = 0
 Select Case fType
    Case "Access"
        ofn.lpstrFilter = _
             "Access" & vbNullChar & "*.md?" & vbNullChar & _
             "Tous" & vbNullChar & "*.*" & vbNullChar & _
             vbNullChar
    Case "Texte"
        ofn.lpstrFilter = _
             "Texte" & vbNullChar & "*.txt;*.asc;*." & vbNullChar & _
             "Tous" & vbNullChar & "*.*" & vbNullChar & _
             vbNullChar
    Case "Excel"
        ofn.lpstrFilter = _
             "Excel" & vbNullChar & "*.xl?" & vbNullChar & _
             "Tous" & vbNullChar & "*.*" & vbNullChar & _
             vbNullChar
    Case "Image"
        ofn.lpstrFilter = _
             "Images" & vbNullChar & "*.bmp;*.gif;*.jpg;*.jpeg" & vbNullChar & _
             "Tous" & vbNullChar & "*.*" & vbNullChar & _
             vbNullChar
    Case ""
        ofn.lpstrFilter = _
             "Tous" & vbNullChar & "*.*" & vbNullChar & _
             vbNullChar
 End Select
 ofn.lpstrCustomFilter = 0
 ofn.nMaxCustFilter = 0
 ofn.nFilterIndex = 0
 ofn.lpstrFile = String(513, vbNullChar) ' Crée un buffer de 512 car
 ofn.nMaxFile = 512
 ofn.lpstrFileTitle = String(513, vbNullChar)
 ofn.nMaxFileTitle = 512
 ofn.lpstrInitialDir = Chemin & vbNullChar
 ofn.lpstrTitle = Titre & vbNullChar
 ofn.Flags = 0
 ofn.nFileOffset = 0
 ofn.nFileExtension = 0
 ofn.lpstrDefExt = 0
 ofn.lCustData = 0
 ofn.lpfnHook = 0
 ofn.lpTemplateName = 0
 
 res = OpenFile(ofn)
 p = InStr(1, ofn.lpstrFile, vbNullChar)
 OuvrirFichier = ""
 If p <> 0 Then OuvrirFichier = Left(ofn.lpstrFile, p - 1)
End Function

2. Copier ce code dans un module de code ou un module de classe de formulaire

Code vb :

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
Sub ChkLinkedTables()
Dim db As DAO.Database, tdef As DAO.TableDef
Dim ConnParams() As String, varParam As Variant, p As Long
Dim strLinkedDBFull As String, strLinkedDB As String, strPWD As String
Dim strNewLinkedDBFull As String, strConn As String
Dim colLinkedDBs As New Collection, strLinkedDBs As String
Dim strTitle As String
 
Set db = CurrentDb
For Each tdef In db.TableDefs
   If (tdef.Attributes And dbAttachedTable) = dbAttachedTable Then
      ConnParams() = Split(tdef.Connect, ";")
      For Each varParam In ConnParams
         ' Récupérer chemin base
         If varParam Like "DATABASE=*" Then
            strLinkedDBFull = Mid(varParam, 10, Len(varParam) - 9)
            ' Si nouvelle base vérifie chemin
            If InStr(1, strLinkedDBs, strLinkedDBFull) = 0 Then
               If Dir(strLinkedDBFull) = "" Then
                  ' Si base introuvable demande nouvel emplacement
                  p = InStrRev(strLinkedDBFull, "\")
                  If p > 1 Then
                     strLinkedDB = Mid(strLinkedDBFull, p + 1, Len(strLinkedDBFull) - p)
                  End If
                  strTitle = "Selectionner la base <" & strLinkedDB & "> depuis nouvel emplacement"
                  strNewLinkedDBFull = OuvrirFichier(strTitle, , "Access")
               Else
                  ' Sinon nouvel emplacement = emplacement actuel
                  strNewLinkedDBFull = strLinkedDBFull
               End If
               ' ajoute base à la liste des bases vérifiées
               strLinkedDBs = strLinkedDBs & strLinkedDBFull & ";"
               colLinkedDBs.Add strNewLinkedDBFull, strLinkedDBFull
            End If
         End If
      Next
   End If
Next
 
For Each tdef In db.TableDefs
   If (tdef.Attributes And dbAttachedTable) = dbAttachedTable Then
      ConnParams() = Split(tdef.Connect, ";")
      strPWD = "": strLinkedDBFull = ""
      For Each varParam In ConnParams
         ' Récuperer mot de passe si existe
         If varParam Like "PWD=*" Then
            strPWD = varParam
         End If
         ' Récupérer chemin base
         If varParam Like "DATABASE=*" Then
            strLinkedDBFull = Mid(varParam, 10, Len(varParam) - 9)
         End If
      Next
      strNewLinkedDBFull = colLinkedDBs(strLinkedDBFull)
      ' Si nouvel emplacement <> emplacement actuel et nouvel
      ' emplacement <> "" alors refaire le lien
      If strNewLinkedDBFull <> strLinkedDBFull And _
         strNewLinkedDBFull <> "" Then
         strConn = ";"
         If strPWD <> "" Then strConn = strConn & strPWD & ";"
         strConn = strConn & "DATABASE=" & colLinkedDBs(strLinkedDBFull)
         ' rafraichir lien
         tdef.Connect = strConn
         tdef.RefreshLink
      End If
   End If
Next
 
Set colLinkedDBs = Nothing
End Sub

La vérification des liens se fait en appelant ChkLinkedTables

A+

**gondole38** · 04/02/2007, 22h00

Bonjour, j'arrive bien a liéé en choisissant une base data, mais je recontre un probleme lorsque ma base data a un mot de passe ( par exemple "tintin").

Dans ton code le compilateur me met une erreur sur :
ConnParams() = Split(tdef.Connect, ";")

Il ne reconait pas "Split(tdef.connect,";") "

C'est 1 fonction que l'on definit ou?

Merci pour tout

**LedZeppII** · 04/02/2007, 23h40

Bonsoir,

Split existe depuis Access 2000.

Voici un lien vers la rubrique Sources pour Split(...).

A+

Rafraichir des tables liées

Access

Discussions similaires

Partager

Partager