lier les tables avec runtime access2003 [Résolu]

[logipsuroit]

Bonjour

Je dois installer l’interface d’une base de données access2003 (formulaire, état, requête, etc…) sur un ordinateur ayant seulement le runtime.

La base de données contenant les tables sera sur un serveur.

Comment puis-je faire pour lier les tables si access2003 n’est pas installé?

merci

[Stargate SG1]

Bonjour, je suis nouveau ici et j'ai la réponse à ta question qui fut mon problème lors de la création BDD avec runtime ACCESS. Je dois ajouter que je ne suis qu'un amateur.

Cette explication considére que la BDD table est sur le serveur et la ou les BDD prog (form, requete, etat,code) sur un ou plusieurs postes.
Cette méthode est valide à chaque lancement de l'appli.
Globalement, il faut:
1 table contenant le chemin de la BDD table et le chemin de la BDD prog
1 table de test avec une valeur de test
1 formulaire pour rétablir la connection avec:
- 2 champs lié à la table chemin BDD
- 2 boutons "parcourir" pour remplir ces champs en ces de modification de chemin
- 1 bouton retablir la connection
- 1 bouton fermer le formulaire (facile)
- 1 bouton quitter l'appli (facile)
- 1 barre de progression (pour s'amuser un peu) MSComctlLib.ProgCtrl.2
- quelques explications sur le formulaire

2 modules spécifiques,

PREMIER MODULE "TEST DE CONNECTION"
ETAPE 1 test de la connection avec le serveur. Ce code est executé au démarrage (macro autoexec par exemple).

Code :

1
2
3
4
5
6
7
8
9
10
Option Compare Database
Option Explicit
Public Function TestConnect()
On Error GoTo gesterreur
    Dim strTest As String
    strTest = DLookup("[Connexion]", "[Test de connexion]")
    Exit Function
gesterreur:
    DoCmd.OpenForm "CHEMIN", acNormal, "", "", , acDialog
End Function

Si la connection ne se fait pas deux solutions.
soit le serveur n'est pas visible (rien à faire de particulier dans ce cas)
soit les liens sont rompus entre les BDD, c'est à dire notre cas d'étude (cas d'une BDD déplacée ou installation initiale).

ETAPE 2 Rétablir la connection
Le code si dessus lance le formulaire
Sans titre.JPG

Code du bouton "parcourir"

Code :

1
2
3
4
5
6
7
8
9
10
11
12
Private Sub cmdParcourir1_Click()

On Error GoTo gesterreur
    If IsNull(Me.txtCheminBase) Then        
        Me.txtCheminBase = ap_OpenFile()
    Else        
        Me.txtCheminBase = ap_OpenFile(Me.txtCheminBase)
    End If    
    Exit Sub
gesterreur:
    MsgBox "Vous n'avez fait aucun choix !", vbOKOnly + vbInformation, "Connexion"
End Sub

SECOND MODULE "API GetOpenFileName"

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
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
Option Compare Text
Option Explicit

Private Declare Function ap_GetOpenFileName Lib "comdlg32.dll" _
                    Alias "GetOpenFileNameA" _
                        (pOpenfilename As OPENFILENAME) As Long
 
Private Type OPENFILENAME
    lStructSize As Long
    hwndOwner As Long
    hInstance As Long
    lpstrFilter As String
    lpstrCustomFilter As String
    nMaxCustFilter As Long
    nFilterIndex As Long
    lpstrFile As String
    nMaxFile As Long
    lpstrFileTitle As String
    nMaxFileTitle As Long
    lpstrInitialDir As String
    lpstrTitle As String
    flags As Long
    nFileOffset As Integer
    nFileExtension As Integer
    lpstrDefExt As String
    lCustData As Long
    lpfnHook As Long
    lpTemplateName As String
End Type

Const cdlOFNAllowMultiselect = &H200
Const cdlOFNCreatePrompt = &H2000
Const cdlOFNExplorer = &H80000
Const cdlOFNExtensionDifferent = &H400
Const cdlOFNFileMustExist = &H1000
Const cdlOFNHelpButton = &H10
Const cdlOFNHideReadOnly = &H4
Const cdlOFNLongNames = &H200000
Const cdlOFNNoChangeDir = &H8
Const CdlOFNNoDereferenceLinks = &H100000
Const cdlOFNNoLongNames = &H40000
Const CdlOFNNoReadOnlyReturn = &H8000
Const cdlOFNNoValidate = &H100
Const cdlOFNOverwritePrompt = &H2
Const cdlOFNPathMustExist = &H800
Const cdlOFNReadOnly = &H1
Const CdlOFNShareAware = &H4000

Public Function ap_OpenFile(Optional ByVal strFileNameIn _
                                         As String = "", Optional strDialogTitle _
                                         As String = "Choisir un fichier")
 
    Dim lngReturn As Long
    Dim intLocNull As Integer
    Dim strTemp As String
    Dim ofnFileInfo As OPENFILENAME
    Dim strInitialDir As String
    Dim strFileName As String
    
    '-- if a file path passed in with the name,
    '-- parse it and split it off.
    
    If InStr(strFileNameIn, "\") <> 0 Then
        
        strInitialDir = Left(strFileNameIn, InStrRev(strFileNameIn, "\"))
        strFileName = Left(Mid$(strFileNameIn, _
                                        InStrRev(strFileNameIn, "\") + 1) & _
                                        String(256, 0), 256)
        
    Else
        
        strInitialDir = Left(CurrentDb.Name, _
                                        InStrRev(CurrentDb.Name, "\") - 1)
        strFileName = Left(strFileNameIn & String(256, 0), 256)
    
    End If
       
    With ofnFileInfo
        .lStructSize = Len(ofnFileInfo)
        .lpstrFile = strFileName
        .lpstrFileTitle = String(256, 0)
        .lpstrInitialDir = strInitialDir
        .hwndOwner = Application.hWndAccessApp
        .lpstrFilter = "All Files (*.*)" & Chr(0) & "*.*" & Chr(0)
        .nFilterIndex = 1
        .nMaxFile = Len(strFileName)
        .nMaxFileTitle = ofnFileInfo.nMaxFile
        .lpstrTitle = strDialogTitle
        .flags = cdlOFNFileMustExist Or cdlOFNHideReadOnly Or _
                            cdlOFNNoChangeDir
        .hInstance = 0
        .lpstrCustomFilter = String(255, 0)
        .nMaxCustFilter = 255
        .lpfnHook = 0
    End With
    
    lngReturn = ap_GetOpenFileName(ofnFileInfo)
    
    If lngReturn = 0 Then
       strTemp = ""
    Else
       
       '-- Trim off any null string
       strTemp = Trim(ofnFileInfo.lpstrFile)
       intLocNull = InStr(strTemp, Chr(0))
       
       If intLocNull Then
          strTemp = Left(strTemp, intLocNull - 1)
       End If
 
    End If

    ap_OpenFile = strTemp
    
End Function

ETAPE 3 LIER LES BDD

Code du bouton "rétablir la connection"

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
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
Private Sub Commande4_Click()



    Dim catDB   As ADOX.Catalog
    Dim tblLink As ADOX.Table
    Dim strDBLinkFrom As String
    Dim strDBLinkSource As String
    
    Dim lngValueBarre As String
    
    Me.BarreProgression.Visible = True
    lngValueBarre = 1
    Me.BarreProgression.Value = lngValueBarre
    
    
    strDBLinkFrom = Me.txtCheminBase
    strDBLinkSource = Me.txtCheminData
On Error GoTo gestErreurFichier
    Set catDB = New ADOX.Catalog
    ' Ouvre un objet Catalog pour la base de données dans laquelle les liens doivent être actualisés.
    
On Error GoTo gesterreur
    catDB.ActiveConnection = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
        "Data Source=" & strDBLinkFrom '<<<<<<<<<<<<<<<
   
    lngValueBarre = lngValueBarre + 1
    Me.BarreProgression.Value = lngValueBarre
    
    For Each tblLink In catDB.Tables
        ' Vérifie qu'il s'agit bien d'une table liée.
        If tblLink.Type = "LINK" Then
        
            tblLink.Properties("Jet OLEDB:Link Datasource") = strDBLinkSource
            lngValueBarre = lngValueBarre + 1
            Me.BarreProgression.Value = lngValueBarre
        End If
        lngValueBarre = lngValueBarre + 1
        Me.BarreProgression.Value = lngValueBarre
    Next
    lngValueBarre = lngValueBarre + 1
    
    Set catDB = Nothing
    
    'création du chemin de sauvegarde
    lngValueBarre = lngValueBarre - 2
    Dim strPathOriginal As String
    Dim lngTest As Long
    Dim lngLongueurPath As Long
    Dim lngNewLongueurPath As Long
    Dim strPathArchive As String
    Dim rs As New ADODB.Recordset
    Dim intVal As Integer
    
    strPathOriginal = DLookup("[Chemin de la base source]", "[chemin]")
    
    lngLongueurPath = Len(strPathOriginal)
    lngTest = 1
    Do While asc(Right(strPathOriginal, lngTest)) <> 92
        lngValueBarre = lngValueBarre + 1
        lngTest = lngTest + 1
    Loop
    lngTest = lngTest - 1
    lngValueBarre = lngValueBarre + 1
    
    lngNewLongueurPath = lngLongueurPath - lngTest
    lngValueBarre = lngValueBarre + 1
    
    strPathArchive = Left(strPathOriginal, lngNewLongueurPath) & "sauvegarde\"
    lngValueBarre = lngValueBarre + 1
    
    rs.Open "[Chemin sauvegarde]", CurrentProject.Connection, adOpenKeyset, adLockOptimistic
    lngValueBarre = lngValueBarre + 1
    
    rs("chemin").Value = strPathArchive
    lngValueBarre = lngValueBarre + 1
    
    rs.Update
    lngValueBarre = lngValueBarre + 1
    rs.Close
    lngValueBarre = lngValueBarre + 1
    
    Set rs = Nothing
    lngValueBarre = lngValueBarre + 1
    
    For intVal = 1 To 700
        DoEvents
    Next intVal
    
    Me.BarreProgression.Value = 70
    MsgBox "Les connexions ont été rétablies." _
    & vbNewLine, vbOKOnly + vbInformation, "Connexion"
    setCheminCourant (Me.txtCheminData.Value)
    Exit Sub
gesterreur:

    MsgBox "Les chemins sont erronés." _
    & vbNewLine & "Veuillez les corriger!", vbOKOnly + vbCritical, "Connexion impossible"
    Me.BarreProgression.Value = 1
    Exit Sub
gestErreurFichier:
    MsgBox "Le fichier ' MSADOX.DLL  '  ne se trouve pas dans le répertoire  ' system ' de windows!" _
    & vbNewLine & "Veuillez réinstaller l'application", vbOKOnly + vbCritical, "Connexion impossible"
    Me.BarreProgression.Value = 1
    Exit Sub
    
End Sub

Bon voilà en prime tu as le code de la barre de progression
amuses toi bien.
Si quelqu'un a plus court je suis preneur.

[logipsuroit]

merci
Je vais essayé ça!

[schventdavid]

j'ai bien suivi mais je ne parviens pas a réaliser cette démo qui m'interresse grandement puisque c'est ce que je cherche a réaliser depuis pas mal de temps et je ne suis pas un expert existe t-il un fichier d'exemple ?

j'ai la base application sur deux postes en runtime et la base des données contenant les tables sur un serveur...je cherche a faire simplement sur mon formulaire de démarrage un bouton qui ferait apparaitre un formulaire de liaisons des tables (genre la msg box access ou l'on coche un nouvel emplacement et on selectionne les tables...puis apparait parcourir ect...)

si quelqu'un peux m'aider merci d'avance

j'ai bien tout fait comme indiqué mais lorsque je lance l'application access me renvoi ce message

Code :

1
2
Private Sub rétablir_la_connection_Click()
Dim catDB As ADOX.Catalog

"erreur de compilation" ???? quelqu'un sait-il pourquoi ?

[schventdavid]

j'ai trouvé pour le premier blocage en fait il fallait déclarer la réference microsoft ADO ext 2.8...

par contre maintenant le blocage se fait au niveau de

Me.BarreProgression.Visible = True

y a t'il encore une référence manquante a déclarer ? car c'est encore une erreur de compilation

[curt]

salut,

pourquoi ne pas faire [TABLES] lier les tables sur ton poste de développement et ensuite générer le .MDE ?

En cas de développement sur un poste hors réseau (c'est mon cas !) j'affecte une lettre de lecteur identique au réseau sur une clé USB ou un disque externe et je mets les tables dans les dossiers à l'identique du serveur.

[schventdavid]

voila tout est fait maintenant une partie fonctionne correctement, j'ai ajouter le controle active x de la progressbar au formulaire..

..mais maintenant je crois que le probleme viens du code du bouton "rétablir la connection" puisque des que je clic dessus j'ai la msgbox d'erreur "connexion impossible" les chemins sont éronnés, veuillez les corriger! ...systématiquement....

vraiment personne pour m'aider ?

[argyronet]

Bonjour,

La réponse est abordée ici...

Sinon, avec la propriété .Connect, tu peux récupérer le chemin de liaison initiale et reconnecter automatiquement les tables avec un TransfertDatabase de l'objet DoCmd.

Argy

[schventdavid]

Envoyé par argyronet

Bonjour,

La réponse est abordée ici...

Sinon, avec la propriété .Connect, tu peux récupérer le chemin de liaison initiale et reconnecter automatiquement les tables avec un TransfertDatabase de l'objet DoCmd.

Argy

merci pour la réponse cher argy, dans le tuto je n'ai pas trouvé ou compris ce qui m'interessait...

par contre je trouvais tres interessant de pouvoir mettre en place un formulaire "gestionnaires d'attaches" au démarrage de l'appli se substituant ainsi à celui d'access mais voila ce fil de post n'a pas été assez etayé pour que je puisse le réaliser à 100% je ne suis pas un expert ni un programmeur mais j'essayes d'avancer...

ce formulaire de demarrage est tout a fait ce dont j'ai besoin et c'est rageant de devoir s'arreter parce que l'on comprend pas ou est le probleme....

donc si une bonne âme peut m'apporter de la lumiere sur le bout de code pour que je sache ou cela coince merci d'avance je pense que c'est au niveau du bouton rétablir la connexion que j'ai fait une erreur je l'ai entierement copié tel quel ! j'ai pas non plus compris la mise en place de la table test....

...au démarrage de mon appli le formulaire créé apparait les boutons parcourir fonctionnent je choisis les fichiers et quand je clic sur retablir j'ai la msg box d'erreur....

[argyronet]

Humm,
Bon, c'est ton jour de chance alors...

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
63
64
65
66
 
 
Private Function GetLinkedDatabaseName() As String
Dim strDBLinkString         As String
 
  strDBLinkString = CurrentDb.TableDefs("Nom d'une table liée").Connect
  GetLinkedDatabaseName = Mid(strDBLinkString, 11)
End Function
 
Public Function ReAttachLinkedTables() As Boolean
Dim oDB                     As dao.Database
Dim oTables                 As dao.TableDef
Dim intNbTables             As Integer
Dim strTableName            As String
Dim strDBPath               As String
Dim T                       As Integer
 
    On Error GoTo ReAttachLinkedTables_Error
    'Le chemin complet de la base sur le serveur
    strDBPath = GetLinkedDatabaseName()
    'Il est préférable d'obtenir le chemin UNC plutôt que la lettre 
    'affectée au Map.
 
   Set oDB = CurrentDb
 
    ''' Supprime d'abord toutes les tables liées...
    For Each oTables In oDB.TableDefs
        strTableName = oTables.Name
        If Left(strTableName, 3) = TBLPx Then
            Select Case strTableName
                ', ....Toutes les tables locales à garder
                Case "TBLParametres"
                ', ... Toutes les tables à lier
                Case "TBLClients", "TBLCommandes"
                    DoCmd.DeleteObject acTable, strTableName
            End Select
        End If
    Next oTables
 
    ''' Relie toutes les tables concernées
    For Each oTables In oDB.TableDefs
        T = T + 1
        strTableName = oTables.Name
        Select Case strTableName
            ', ....Toutes les tables locales à garder
            Case "TBLParametres"
            ', ... Toutes les tables à lier
            Case "TBLClients", "TBLCommandes"
                DoCmd.TransferDatabase acLink, "Microsoft Access", _
                strDBPath, acTable, strTableName, strTableName
        End Select
    Next oTables
 
    ReAttachLinkedTables = True
    On Error GoTo 0
 
ReAttachLinkedTables_Exit:
    If Not oDB Is Nothing Then oDB.Close
    Set oTables = Nothing
    Set oDB = Nothing
    Exit Function
 
ReAttachLinkedTables_Error:
    ReAttachLinkedTables = False
    Resume ReAttachLinkedTables_Exit
End Function

Argy

[schventdavid]

Merci pour cette réponse c'est presque mon jour de chance alors

alors premiere question : ce code doit etre ecrit ou et doit se mettre ou ? en autoexec au demarrage ?

2 : est-ce qu'il vient en complement de toutes les manips précédemment citées ? c'est a dire la création du formulaire de liaison décrit par stargate ou il le remplace tout simplement.

3 : est ce que cela permet de trouver le nouveau chemin "seul" ou un formulaire apparait pour trouver en parcourant le réseau le nouveau chemin de la base data.

4 : est ce que dans l'exemple de tables notées :

Case "TBLParametres"
', ... Toutes les tables à lier
Case "TBLClients", "TBLCommandes"

je dois déclarées donc écrires toutes mes tables ?

bon je crois que apres la réponse a ces question je serais un peu plus intelligent...

[argyronet]

Bien en fait, ce code est totalement indépendant de ce qui a été écrit.
Il te permet de retrouver le chemin de la base pointant sur le serveur à partir d'un nom d'une table que tu sais liée.

1/ Pour son usage, le mieux est de la mettre en appel dans un formulaire de démarrage mais tu dois cependant vérifier que les tables n'ont pas déjà été rattachées car il est inutile de les rattacher à chaque ouverture. la BDD ne change pas de serveur tous les jours !!!

Par exemple:

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
 
 
Private Sub Form_Load()
Dim strError                As String
    If TableAlreadyAttached = False Then
        MsgBox "Les tables ont besoin d'être rattachées...", 64, _
            "Information utilisateur"
        If ReAttachLinkedTables(strError) = True Then
        Else
            MsgBox "Les tables n'ont pas pu être rattachées..." & vbCrLf & _
                strError, vbExclamation, "Echec de rattachement"
        End If
    End If
End Sub
 
Private Function TableAlreadyAttached() As Boolean
    ' Cherche la valeur du champ Attach_State dans la table TBLSystemApp
    ' où la clé IDKey = Linkedtable
    TableAlreadyAttached = DLookup("Attach_State", "TBLSystemApp", _
        "[IDKey]='Linkedtable'")
End Function
 
Private Function ReAttachLinkedTables(ByRef strError As String) As Boolean
    On Error GoTo ReAttachLinkedTables_Error
 
    [...]
 
    On Error GoTo 0
ReAttachLinkedTables_Exit:
    Exit Function
 
ReAttachLinkedTables_Error:
    strError = Err.Number & " (" & Err.Description & _
        ") in procedure ReAttachLinkedTables()"
    Resume ReAttachLinkedTables_Exit
End Function

2/ Rien à voir avec ce que Stargate t'as proposé... En fait, comme il le dit lui même :

Envoyé par Stargate

Si quelqu'un a plus court je suis preneur.

Donc c'est plus court, n'est-ce pas ?

3/ La propriété Connect associée à la fonction GetLinkedDatabaseName() permet de trouver le chemin de la base qui a été déclarée dans le gestionnaire d'attache.
4/ Les tables citées sont des exemples. Toi, tu mets les tiennes. Les tables locales sont celles que tu ne veux pas attacher et qui font partie intégrante de l'application. Par exemple, la table TBLSystemApp que tu dois créer comme dans cet exemple de code.

Argy

[Stargate SG1]

Bonjour
très intéressant de retrouver ce vieux post qui maintenant contient de nouvelles idées

Merci

[schventdavid]

Merci à vous pour votre aide précieuse le problème est résolu
(je ne sais pas comment on fait pour mettre la balise "résolu")

en fait dans mon cas précis le formulaire de stargate était la meilleure solution et lui meme m'a apporté les correctifs necessaires à son bon fonctionnement.

David

[curt]

Bonjour Argy,

je suis en train d'essayer de mettre en place ton code pour réattacher des tables liées.

Peux-tu stp m'éclairer sur

4/ Les tables citées sont des exemples. Toi, tu mets les tiennes. Les tables locales sont celles que tu ne veux pas attacher et qui font partie intégrante de l'application. Par exemple, la table TBLSystemApp que tu dois créer comme dans cet exemple de code.

je ne vois pas quels sont les champs de la TBLSystemApp.

Merci pour ce code en tout cas.
Curt

[argyronet]

Curt,

Dans mes développements Access, les tables locales - en général : préférences utilisateur, paramètres (Couleurs, Polices, Positions des objets), Version etc... - sont stockées en dur dans le MDE avec, pour les données vulnérables, un cryptage conséquent, sont nommées TBLSysxxxxxxxx
les tables liées quant à elles sont nommées TBL_xxxxxxxx
où xxxxxxxx représente un nom circonstanciel.

Cela me permet de faire la différence entre une table à Rattacher et les autres en excluant les Tables systèmes.

Argy

[curt]

Re-Bonjour Argy,

je ne dois pas être en forme aujourd'hui, je ne comprends pas comment fonctionne ton code.

Systématiquement, la table liée (1 seule dans cet exemple) doit être ré-attachée. Il s'en suit une erreur 2465 (impossible de trouver le champs, etc...)

A toute fin utile, je mets la base exemple en pièce jointe... si tu pouvais y jeter un oeil.

D'avance merci.
Curt

[argyronet]

C'est normal !!!
Ton formulaire d'attache ne doit en aucun cas être lié...

C'est un formulaire indépendant dépourvu de champs avec une image circonstancielle et un message idoine qui se charge de faire cette opération.
Perso, j'utilise le formulaire de démarrage, celui qui fait un ti splash avant d'ouvrir la base...

Là, ce que tu m'as envoyé ne pourra jamais marcher parce que tu ne peux pas accéder à la base BDLIEE.mdb.

Donc, oui, tu peux aller faire une sieste

Argy

[curt]

Merci Argy...

tu as TOUT A FAIT raison !!! ça roule effectivement avec un formulaire indépendant.

Pour finir, je viens de passer en MEMBRE EPROUVE.... normal que je sois fatigué !!!

Merci pour tout.
Curt