bug sur TableDefs.Append

Version imprimable

Bonjour à toutes et tous !

Je viens aujourd'hui demander votre aide pour résoudre un problème mystérieux...

Il s'agit d'un bout de programme destiné à régénérer les tables liées d'une base frontale.

Comme indiqué dans le titre, la procédure plante au moment d'ajouter la table à la collection TableDefs.

Ce qui rend le problème mystérieux : ça fonctionne chez moi, mais nulle part ailleurs 8O

Voilà le code, divisé en 3 procédures situées dans un même module standard :

D'abord, la procédure générale (celle qui appelle les autres) :

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
Public Sub RegenererTablesLiees()
    ' Invite l'utilisateur à sélectionner la source de données via une boîte de dialogue "Ouvrir...",
    ' puis supprime toutes les tables liées de l'application avant de les recharger depuis la source désignée.
    ' L'opération peut être abandonnée au moment de la sélection, mais plus après.
 
    Dim strSource As String
    Dim objRst As Recordset
 
    ' Initialisation de la gestion d'erreurs
    booErreurSuppressionTables = False
    intNbErreurs = 0
    intNbBouclesErreur = 0
 
 
    ' Invite l'utilisateur à sélectionner la source (procédure dans le module "RechercheFichiers")
    strSource = SelectionnerSource
 
    ' Si l'utilisateur a abandonné l'opération lors de l'étape de sélection de la source,
    If strSource = strSelectionSourceAnnulee Then
        If booAppelManuelRegenerationLiaison Then Exit Sub  ' quitte directement la procédure si elle a été appelée manuellement,
        ErreurLiaison                                       '  sinon déclenche la gestion d'erreur de liaison.
        GoTo Sortie
    End If
 
 
    ' Une source a bien été sélectionnée, donc on démarre la régénération
    intNbEtapesProgression = (NbTablesLiees() + (NbTablesDistantes(strSource) * 3)) + 3
    strDetails = "Opération en cours : Régénération de la liaison avec la source de données..."
 
    OuvrirFormulaireAttente strFormulaireLiaisonRegeneration, intNbEtapesProgression, , strDetails
 
Suppression:
    ' Suppression des tables liées
    SupprimerTablesLiees
    If booErreurSuppressionTables Then intNbBouclesErreur = intNbBouclesErreur + 1
 
    ' Régénération des tables liées
    LierTables
 
    ' Vérification de la liaison
    If LiaisonOk = False Then   ' si la liaison n'est pas bonne,
        ErreurLiaison           ' repart en erreur
        GoTo Sortie             ' et sort de la procédure
    End If
 
    ' Anonce de la réussite de la régénération des liens,
    MajProgression strFormulaireActif, 100, "Régénération des tables liées réussie !"
 
    ' et affichage du bouton "Fermeture" du formulaire d'attente
    Forms(strFormulaireActif).Controls(strNomBoutonFermetureFormulaireLiaisonRegeneration).Visible = True
 
Sortie:
    If booErreurSuppressionTables Then
        booErreurSuppressionTables = False
        If intNbBouclesErreur > 1 Then
            ErreurLiaison
            Exit Sub
        End If
        GoTo Suppression
    Else
        Exit Sub
    End If
 
Erreur:
    intNbErreurs = intNbErreurs + 1
    If intNbErreurs = 1 Then intNbEtapesProgression = intNbEtapesProgression * 2
    booErreurSuppressionTables = True
    Resume Next
End Sub

Ensuite, la procédure de suppression appelée à la ligne 34 de la précédente :

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
Private Sub SupprimerTablesLiees()
    Dim objRst As Recordset
    Dim varTampon() As Variant
    Dim strSql As String, strNomTable As String
    Dim n As Integer
 
    strSql = "SELECT MSysObjects.Name " & _
             "FROM MSysObjects " & _
             "WHERE (((MSysObjects.Type)=6));"      ' MSysObjects est la table système qui contient tous les objets Access,
                                                    ' sachant que 6 est le type correspondant aux tables liées.
 
    Set objRst = CurrentDb.OpenRecordset(strSql)
 
    With objRst
        If .RecordCount = 0 Then GoTo Sortie
        .MoveFirst
        While Not .EOF
            On Error GoTo Erreur
            strNomTable = .Fields(0).Value
            MajProgression strFormulaireActif, 1, "Opération en cours : Suppression de la table " & strNomTable
            DoCmd.RunSQL "DROP TABLE [" & strNomTable & "] ;"
            .MoveNext
        Wend
    End With
 
Sortie:
    Set objRst = Nothing
    Exit Sub
 
Erreur:
    n = n + 1
    If n = 1 Then intNbEtapesProgression = intNbEtapesProgression * 2
    booErreurSuppressionTables = True
    Resume Next
End Sub

Enfin, celle qui bugue, elle aussi appelée par la première à la ligne 38. Le bug intervient à la ligne 58 :

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
Private Sub LierTables(Optional ByVal CheminCompletSource As String)
    Dim objDb As Database
    Dim objDbSource As Database
    Dim objTbl As TableDef
    Dim objTblSource As TableDef
    Dim strNomTable As String
 
    Dim strMotPasse As String
    Dim strCheminBdd As String
    Dim strConnect As String
    Dim strTemp As String
    Dim intNbTablesDistantes As Integer
 
 
    ' Définition chemin et mot passe pour l'accès à la base dorsale
    If Nz(CheminCompletSource, "") = "" Then
        strCheminBdd = NormaliserChemin(DonneeSysteme(strNomVariableCheminSource)) & DonneeSysteme(strNomVariableNomSource)
    Else
        strCheminBdd = CheminCompletSource
    End If
 
    strMotPasse = ""
 
 
    'Définition de la chaine de connexion permettant la liaison des tables
'    strConnect = "MS Access;pwd=" & strMotPasse & ";DATABASE=" & strCheminBdd
    strConnect = "MS Access;DATABASE=" & strCheminBdd & ";pwd=" & strMotPasse
 
    'Instancie l'objet Database de la base courante
    Set objDb = CurrentDb
 
    'Instancie l'objet Database de la base dorsale
    Set objDbSource = DBEngine.OpenDatabase(strCheminBdd, True, True, strConnect)
    intNbTablesDistantes = objDbSource.TableDefs.Count
 
    ' Rattache une à une les tables de la base dorsale
    MajProgression strFormulaireActif, 0, "Opération en cours : Préparation au traitement de " & intNbTablesDistantes & " tables distantes..."
 
        For Each objTblSource In objDbSource.TableDefs
            strNomTable = objTblSource.Name
            If Left(strNomTable, 4) = "MSys" Then
                MajProgression strFormulaireActif, 1, "Opération en cours : Discrimination des tables système..."
                GoTo TableSuivante
            End If
            ' Création d'une table locale
            MajProgression strFormulaireActif, 1, "Opération en cours : Création de la table locale " & strNomTable & "..."
            Set objTbl = objDb.CreateTableDef(strNomTable)
            DoEvents
 
            ' Liaison de cette table à sa dorsale
            MajProgression strFormulaireActif, 1, "Opération en cours : Liaison de la table locale " & strNomTable & " à sa dorsale..."
            objTbl.Connect = strConnect
            objTbl.SourceTableName = strNomTable
            DoEvents
 
            'Ajoute la table à la collection des tables de la base de données en cours
            MajProgression strFormulaireActif, 1, "Opération en cours : Référencement de la table " & strNomTable & " dans l'application..."
            objDb.TableDefs.Append objTbl
            DoEvents
 
            ' Passage à la table suivante
TableSuivante:
        Next
 
    MajProgression strFormulaireActif, 1, "Opération en cours : Raffraîchissement de la liste des tables..."
    objDb.TableDefs.Refresh
 
Sortie:
    ' Libération des variables objet
    Set objRst = Nothing
    Set objTbl = Nothing
    Set objDb = Nothing
    Set objDbSource = Nothing
End Sub

Merci d'avance à quiconque aura une piste à me proposer, et pourquoi pas (soyons gourmands !) une explication suivie d'une solution ?

25/01/2014, 11h03
Tofalu

Quel est le message d'erreur ?

Bonjour Tofalu.

Erreur et variables en contexte :

Citation:

Envoyé par Microsoft Visual Basic

Erreur d'exécution '3001':
Argument non valide.
Code:

1 2 3 4 objDb.Name = nom de la base frontale, comme attendu objDbSource = nom de la base dorsale, comme attendu objTbl.Name = nom de la table, comme attendu strConnect = "MS Access;DATABASE=C:\...NomDeLaDorsale.accdb;pwd="
J'ai cependant remarqué :
Code:

1 2 3 4 ? objDbSource.TableDefs(objTbl.Name).Fields.Count 10 ? objTbl.Fields.Count 0

Bonjour à tout le monde !

Je reviens avec une réponse :

Il semblerait que l'inversion des paramètres dans la chaîne de connexion ait résolu le problème (inversion de l'état de commentaire lignes 27 et 28 dans la procédure "LierTables" :

Code:

1
2
3
4
5
6
7
'Original :
'    strConnect = "MS Access;pwd=" & strMotPasse & ";DATABASE=" & strCheminBdd
    strConnect = "MS Access;DATABASE=" & strCheminBdd & ";pwd=" & strMotPasse
 
Modifié et fonctionnel :
    strConnect = "MS Access;pwd=" & strMotPasse & ";DATABASE=" & strCheminBdd
'    strConnect = "MS Access;DATABASE=" & strCheminBdd & ";pwd=" & strMotPasse

J'avais testé en inversant les paramètres dans la chaîne de connexion, ça semblait fonctionner sur ma machine, mais ça posait problème et il semble que ça roule à nouveau en remettant le pwd avant la base... c'est qu'il serait capricieux le gars !

Ceci étant, je tombait à la même ligne 58 sur une autre erreur du genre :

Citation:

Impossible de modifier MaBaseDorsale car l'objet est déjà utilisé.

J'ai donc pris le parti de modifier mon code : Au lieu d'ajouter les tables à la frontale au fur et à mesure que je parcourais la dorsale, j'ai pris le parti de stocker les noms des tables dans une variable tableau, de fermer la dorsale, et seulement ensuite d'ajouter les tables.
Apparemment tout semble maintenant fonctionner normalement.

Je vous livre le code, au cas où ça pourrait intéresser quelqu'un (seule cette procédure change) :

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
Private Sub LierTables(Optional ByVal CheminCompletSource As String)
    Dim objDb As Database
    Dim objDbSource As Database
    Dim objTbl As TableDef
    Dim objTblSource As TableDef
    Dim strNomTable As String
    Dim strTables As String
    Dim varTables() As String, varNomTable As Variant
 
    Dim strMotPasse As String
    Dim strCheminBdd As String
    Dim strConnect As String
    Dim intNbTablesDistantes As Integer
 
 
    ' Définition chemin et mot passe pour l'accès à la base dorsale
    If Nz(CheminCompletSource, "") = "" Then
        strCheminBdd = NormaliserChemin(DonneeSysteme(strNomVariableCheminSource)) & DonneeSysteme(strNomVariableNomSource)
    Else
        strCheminBdd = CheminCompletSource
    End If
 
    strMotPasse = ""
 
 
    'Définition de la chaine de connexion permettant la liaison des tables
    strConnect = "MS Access;pwd=" & strMotPasse & ";DATABASE=" & strCheminBdd
'    strConnect = "MS Access;DATABASE=" & strCheminBdd & ";pwd=" & strMotPasse
 
    'Instancie l'objet Database de la base courante
    Set objDb = CurrentDb
 
    'Instancie l'objet Database de la base dorsale
    Set objDbSource = DBEngine.OpenDatabase(strCheminBdd, True, True, strConnect)
    intNbTablesDistantes = objDbSource.TableDefs.Count
 
    ' Dresse et stocke la liste des tables de la base dorsale
    For Each objTblSource In objDbSource.TableDefs
        strNomTable = objTblSource.Name
        If Left(strNomTable, 4) <> "MSys" And Left(strNomTable, 4) <> "USys" Then strTables = strTables & strNomTable & "|"
    Next
    varTables() = Split(Left(strTables, Len(strTables) - 1), "|")
    objDbSource.Close
    Set objTblSource = Nothing
    Set objDbSource = Nothing
 
    ' Rattache une à une les tables de la base dorsale
    MajProgression strFormulaireActif, 0, "Opération en cours : Préparation au traitement de " & intNbTablesDistantes & " tables distantes..."
 
    For Each varNomTable In varTables
        ' Création d'une table locale
        MajProgression strFormulaireActif, 1, "Opération en cours : Création de la table locale " & varNomTable & "..."
        Set objTbl = objDb.CreateTableDef(varNomTable)
        DoEvents
 
        ' Liaison de cette table à sa dorsale
        MajProgression strFormulaireActif, 1, "Opération en cours : Liaison de la table locale " & varNomTable & " à sa dorsale..."
        objTbl.Connect = strConnect
        objTbl.SourceTableName = varNomTable
        DoEvents
 
        'Ajoute la table à la collection des tables de la base de données en cours
        MajProgression strFormulaireActif, 1, "Opération en cours : Référencement de la table " & varNomTable & " dans l'application..."
        objDb.TableDefs.Append objTbl
        DoEvents
 
        ' Passage à la table suivante
    Next
 
    MajProgression strFormulaireActif, 1, "Opération en cours : Raffraîchissement de la liste des tables..."
    objDb.TableDefs.Refresh
 
Sortie:
    ' Libération des variables objet
    Set objRst = Nothing
    Set objDb = Nothing
End Sub

A titre indicatif, MajProgression est une procédure qui met à jour un formulaire d'attente censé éviter à l'utilisateur de se poser des questions sur ce qui se passe "sous le capot".

Je marque donc ce sujet comme résolu, mais si quelqu'un peut amener une explication technique à ces erreurs, je pense que toute la communauté lui en sera reconnaissante (comme je le répète souvent en formation : Résoudre, c'est bien... Comprendre, c'est mieux !)