Discussion :

[CrasherSEP]

Bonjour,

J'ai deux fichiers Access, le premier (A) contient les tables, le deuxième (B) contient les requêtes, formulaires, états, macros et les tables "liées" du fichier (A).

Le fichier (B) se trouve sur un autre PC que le fichier (A), un réseau quoi...

Donc, si le fichier (B) est lancé et que le PC contenant le fichier (A) n'est pas ouvert, le fichier (B) ne fonctionne pas, normal :-)

Mon problème est qu'il y a du code VBA dans le fichier (B), donc si le fichier (A) n'est pas accessible, j'ai des messages d'erreur...

J'aimerais donc au lancement du fichier (B), tester si les connexions aux tables liées (fichier (A)) est correct, en testant par exemple si la liaison avec la table [Users] est correct. Si pas de liaison, alors une fenêtre s'ouvre avec un message d'alerte et évidemment tout le code qui suit est stoppé !

Pourriez-vous m'aider ?

Ps : j'ai trouvé ceci, mais...

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
dim db as dao.database
dim tb as dao.tabledef
set db=opendatabase(.......)
for each tb in db.tabledefs
if tb.attributes and dbattachedtable then
........
 
End If
Next
BDDClose '
db.Close
Set db = Nothing
Set tb = Nothing

Merci d'avance pour votre aide :-)

Bien à vous

EDIT
===
Je crois avoir trouvé, je test...

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
Public Function VerifierLiens()
 
'--------------------------------------------------------------------------------------------
' Projet          : Environnement application
' Auteur          : Pierre (3stone) - <a href="http://www.3stone.be/access/" target="_blank">http://www.3stone.be/access/</a>
' Version / Date  : 1.0 / 01.01.2008
' Révision / Date : -
' Commentaires    : Permet de vérifier la connexion aux tables attachées
' Lien            : <a href="http://www.3stone.be/access/articles.php?lng=fr&pg=28" target="_blank">http://www.3stone.be/access/articles.php?lng=fr&pg=28</a>
'--------------------------------------------------------------------------------------------
 
    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
 
        'Erreur. Les tables ont été déplacées.
        MsgBox "Problème de table", vbExclamation
        DoCmd.Quit
 
 
    End If
 
    rst.Close
    Dbs.Close
    Set rst = Nothing
    Set Dbs = Nothing
 
End Function

J'ai aussi trouvé ceci, mais je n'arrive à rien faire fonctionner...

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
Function ExisteTableDATA(NomTable As String)
    Dim Db As DAO.Database
    Dim tbd As DAO.TableDef
    Dim fld As DAO.Field
 
    strPath = DLookup("[Chemin de la base source]", "[CHEMIN]")
 
    Set Db = OpenDatabase(strPath)
 
    For Each tbd In Db.TableDefs
        If tbd.Name = NomTable Then
            ExisteTableDATA = True
        Exit For
        End If
    Next
End Function

EDIT
===

Le code [VerifierLiens], fonctionne, mais est-il possible pour une question de vitesse, de faire juste le test sur une table, comme par exemple la table [Users]

[argyronet]

Bonjour,

Voilà une piste (+) simple :

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
 
 
Private Function ApplicationIsAvailable(ByVal TableName As String, ByRef Message As String) As Boolean
Dim SQL                                                As String
Dim oRS                                                As DAO.Recordset
 
    On Error GoTo L_ErrApplicationIsAvailable
 
    SQL = "SELECT * FROM [" & TableName & "];"
    Set oRS = CurrentDb.OpenRecordset(SQL, dbOpenDynaset)
    oRS.Close
    ApplicationIsAvailable = True
    On Error GoTo 0
L_ExApplicationIsAvailable:
    Set oRS = Nothing
    Exit Function
 
L_ErrApplicationIsAvailable:
    Rem Message = "(" & err.Number & ") " & err.Description
    Message = "Ben désolé, mais la base du serveur est inceccessible pour l'instant." & vbCrLf & "revenez un peu plus tard..."
    Resume L_ExApplicationIsAvailable
End Function
 
Public Sub Test()
Const TABLE_TEST                                       As String = "Users"
Dim strMessage                                         As String
    If ApplicationIsAvailable(TABLE_TEST, strMessage) = False Then
        'Ooops !
        MsgBox strMessage, vbExclamation, "Erreur"
        Rem Application.Quit
    Else
        'Tout va bien...
        MsgBox "C'est bon.", vbInformation, "Cool, on va bosser"
    End If
End Sub

Argy

[CrasherSEP]

Merci je test :-)