Parcours du nom de tables [Résolu]

[Nitromard]

Bonjour à tous,

Je vous expose mon problème :

J'ai un programme VBA Access qui me permet de prendre un fichier excel après l'autre dans un répertoire et de coller les données dans une table access.
Je l'ai modifié pour pouvoir en fait lire le nom de ce fichier excel, lire le nom de ma table access et lorsque cela correspond, il importe bien les données dans la bonne table.

Mon problème est que je n'arrive pas encore à parcourir les tables de ma base de données (en fait j'utilise ma base active).
Voici le code :

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
Sub tranfertFeuilleClasseursFermes_VersAccess()
Dim Cn As New ADODB.Connection
Dim oProdRS As New ADODB.Recordset, oRS As ADODB.Recordset
Dim oConn As ADODB.Connection
Dim j As Integer
Dim Fichier As String, Repertoire As String
Dim Tbl As ADOX.Table

 
'Boucle sur les classeurs Excel du répertoire cible
Repertoire = "C:\Users\myname\Desktop\Work\Données\Folder"
Fichier = Dir(Repertoire & "\*.xls")


Do While Fichier <> ""
    'Connection au classeur Excel
    Cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
    "Data Source=" & Repertoire & "\" & Fichier & ";" & _
    "Extended Properties=""Excel 8.0;"""

    'Connection à la Base Access
    Set oConn = CurrentProject.Connection
    Set oRS = New ADODB.Recordset
    
    'Parcours du nom des tables de la base pour le fichier
    For Each Tbl In CurrentProject.Tables        TableName = Tbl.Name
        If Fichier = (TableName & ".xls") Then
        
        'requête pour extraire les données de la Feuil1
        oProdRS.Open "SELECT * FROM [Sheet1$]", Cn, adOpenStatic
        oRS.Open "Select * from TableName", oConn, adOpenKeyset, adLockOptimistic
        
        ' --- Transfert des données dans la base ---
            Do While Not (oProdRS.EOF)

                oRS.AddNew
                    For j = 0 To oRS.Fields.Count - 1
                    oRS.Fields(j) = oProdRS.Fields(j).Value
                    Next j
                oRS.Update
                oProdRS.MoveNext
            Loop
            
        ElseIf Left(Fichier, 3) = "NAV" Then
        
        'requête pour extraire les données de la Feuil1
        oProdRS.Open "SELECT * FROM [Sheet1$]", Cn, adOpenStatic
        oRS.Open "Select * from TableName", oConn, adOpenKeyset, adLockOptimistic
        
        ' --- Transfert des données dans la base ---
            Do While Not (oProdRS.EOF)

                oRS.AddNew
                    For j = 0 To oRS.Fields.Count - 1
                    oRS.Fields(j) = oProdRS.Fields(j).Value
                    Next j
                oRS.Update
                oProdRS.MoveNext
            Loop
        
        
        'Else créer une table avec nom du fichier
        End If
    Next Tbl
    
    oProdRS.Close
    'Fermeture de la connection au classeur Excel
    Cn.Close
Fichier = Dir
Loop

oRS.Close
Set oRS = Nothing
'Fermeture de la connection Access
oConn.Close
Set oConn = Nothing
End Sub

J'ai mis en jaune le problème là où j'ai une erreur : "Object does not support this property or method".
En fait j'aimerais parcourir les tables de ma base active.

Mon second problème est qu'il faudrait (comme indiqué dans le programme) une 3ème condition dans mon If c'est-à-dire quand aucune des 2 conditions de lecture du nom de la table avec le nom du fichier n'est bonne : Créer une table pour y mettre les données.
En fait je vais sans doute créer une table source qui servira de modèle avec plusieurs champs dont 2 qui formeront la clé et j'aimerais en créer une copie à chaque fois que mes conditions ne sont pas vérifiées et cette copie aura le nom du fichier.(sans le .xls de préférence)

J'espère avoir été assez précis.

Merci d'avance pour votre aide.

Cordialement,

Nitromard

[jpcheck]

Salut,

l'objet que je te recommande plutot d'utiliser est
CurrentDb

Code :

For each tbl in CurrentDb.TableDefs

[Nitromard]

Ok, j'ai tenté avec TableDefs, j'ai donc le programme :

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
Sub tranfertFeuilleClasseursFermes_VersAccess()
Dim Cn As New ADODB.Connection
Dim oProdRS As New ADODB.Recordset, oRS As ADODB.Recordset
Dim oConn As ADODB.Connection
Dim j As Integer
Dim Fichier As String, Repertoire As String
Dim Tbl As TableDef

 
'Boucle sur les classeurs Excel du répertoire cible
Repertoire = "C:\Users\qdeutschle\Desktop\Work\Données\Folder"
Fichier = Dir(Repertoire & "\*.xls")


Do While Fichier <> ""
    'Connection au classeur Excel
    Cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
    "Data Source=" & Repertoire & "\" & Fichier & ";" & _
    "Extended Properties=""Excel 8.0;"""

    'Connection à la Base Access
    Set oConn = CurrentProject.Connection
    Set oRS = New ADODB.Recordset
    
    'Parcours du nom des tables de la base pour le fichier
    For Each Tbl In CurrentDb.TableDefs
        TableName = Tbl.Name
        If Fichier = (TableName & ".xls") Then
        
        'requête pour extraire les données de la Feuil1
        oProdRS.Open "SELECT * FROM [Sheet1$]", Cn, adOpenStatic
        oRS.Open "Select * from TableName", oConn, adOpenKeyset, adLockOptimistic
        
        ' --- Transfert des données dans la base ---
            Do While Not (oProdRS.EOF)

                oRS.AddNew
                    For j = 0 To oRS.Fields.Count - 1
                    oRS.Fields(j) = oProdRS.Fields(j).Value
                    Next j
                oRS.Update
                oProdRS.MoveNext
            Loop
            
        ElseIf Left(Fichier, 3) = "NAV" Then
        
        'requête pour extraire les données de la Feuil1
        oProdRS.Open "SELECT * FROM [Sheet1$]", Cn, adOpenStatic
        oRS.Open "Select * from TableName", oConn, adOpenKeyset, adLockOptimistic
        
        ' --- Transfert des données dans la base ---
            Do While Not (oProdRS.EOF)

                oRS.AddNew
                    For j = 0 To oRS.Fields.Count - 1
                    oRS.Fields(j) = oProdRS.Fields(j).Value
                    Next j
                oRS.Update
                oProdRS.MoveNext
            Loop
        End If
    Next Tbl
    
'Si pas de table du nom du fichier, créer une table
    
    oProdRS.Close    
'Fermeture de la connection au classeur Excel
    Cn.Close
Fichier = Dir
Loop

oRS.Close
Set oRS = Nothing
'Fermeture de la connection Access
oConn.Close
Set oConn = Nothing
End Sub

J'ai alors l'erreur : Operation is not aloowed when the object is closed
Sur la ligne en rouge dans le code.

[jpcheck]

yep,

met ton .close dans ta boucle du dessus

[Nitromard]

Ok super, j'ai encore un autre problème ^^.

Il faudrait qu'a la fin du parcours de mes tables, si aucune table ne correspond, créer une table avec le nom de la feuille excel.(table qui est une copie d'une table source)
Comment faire ?

En fait j'ai déja cette fonction :

CurrentDb.Execute "SELECT * INTO [" & Fichier & "] FROM TableSource"Il faudrait que j'enlève le .xls a l'intérieur du nom de Fichier.
Et le problème est que cette fonction ne me copie pas les clés primaires...

[Nitromard]

Au fait, j'ai aussi un problème au niveau des doublons, en fait j'aimerais pouvoir sauter l'erreur des doublons lorsqu'il en rencontre et ainsi continuer le programme normalement.
Donc qu'il me gère les doublons, sans me donner d'erreur et sans arrêter le programme...

[jpcheck]

Peut-on traiter un probleme a la fois.

Ne nous eparpillons pas, je ne suis pas a ce point multi fonction

[Nitromard]

Ok pas de problème, c'est déjà très gentil à vous de m'aider ^^!
Donc pour commencer il faudrait que le programme créé une nouvelle table(en la copiant d'une table déjà existante, où il n'y a que des champs et 2 clés primaires).

J'ai déjà ce bout de programme qui fonctionne bien :

Code :

1
2
 
CurrentDb.Execute "SELECT * INTO [" & Fichier & "] FROM TableSource"

Par contre il ne copie pas les clés primaires.
Il faudrait que :
Lorsque j'ai passé mes 2 conditions IF sur l'ensemble de mes tables, et que je n'ai pas mis à jour de tables déjà existante.
Je crée une table portant le nom du fichier excel exploité.

Mon probème est que je n'arrive pas à voir comment faire cette condition, je pensais faire quelque chose du genre :

Si il n'existe pas de table portant le nom du fichier, alors créer une table avec le nom du fichier.

Et aussi que lorsqu'il crée cette table, il y ait les clés primaires de la table source.(cad la table que j'ai copié pour la créer)

[Nitromard]

Bon j'ai trouvé une solution, par contre j'ai une erreur :
Type mismatch sur la ligne en rouge :

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
116
Sub tranfertFeuilleClasseursFermes_VersAccess()
Dim Cn As New ADODB.Connection
Dim oProdRS As New ADODB.Recordset, oRS As ADODB.Recordset
Dim oConn As ADODB.Connection
Dim j As Integer
Dim Fichier As String, Repertoire As String
Dim Tbl As TableDef
Dim Fich As String
 
'Boucle sur les classeurs Excel du répertoire cible
Repertoire = "C:\Users\qdeutschle\Desktop\Work\Données\Folder"
Fichier = Dir(Repertoire & "\*.xls")

'Connection à la Base Access
Set oConn = CurrentProject.Connection
Set oRS = New ADODB.Recordset

Do While Fichier <> ""
    'Connection au classeur Excel
    Cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
    "Data Source=" & Repertoire & "\" & Fichier & ";" & _
    "Extended Properties=""Excel 8.0;"""
    
    'Parcours du nom des tables de la base pour le fichier
    For Each Tbl In CurrentDb.TableDefs
        Fich = Left(Fichier, Len(Fichier) - 4)
        TableName = Tbl.Name
        If Fich = TableName Then
        
        'requête pour extraire les données de la Feuil1
        oProdRS.Open "SELECT * FROM [Sheet1$]", Cn, adOpenStatic
        oRS.Open "Select * from " & TableName & "", oConn, adOpenKeyset, adLockOptimistic
        
        ' --- Transfert des données dans la base ---
            Do While Not (oProdRS.EOF)

                oRS.AddNew
                    For j = 0 To oRS.Fields.Count - 1
                    oRS.Fields(j) = oProdRS.Fields(j).Value
                    Next j
                oRS.Update
                oProdRS.MoveNext
            Loop
        oProdRS.Close
        oRS.Close
            
        ElseIf Left(Fichier, 3) = "NAV" Then
        
        'requête pour extraire les données de la Feuil1
        oProdRS.Open "SELECT * FROM [Sheet1$]", Cn, adOpenStatic
        oRS.Open "Select * from " & HISTO_FUND & "", oConn, adOpenKeyset, adLockOptimistic
        
        ' --- Transfert des données dans la base ---
            Do While Not (oProdRS.EOF)

                oRS.AddNew
                    For j = 0 To oRS.Fields.Count - 1
                    oRS.Fields(j) = oProdRS.Fields(j).Value
                    Next j
                oRS.Update
                oProdRS.MoveNext
            Loop
        oProdRS.Close
        oRS.Close
        End If
    Next Tbl
    
'Si pas de table du nom du fichier, créer une table
'        If Fich <> TableName Then
'            CurrentDb.Execute "SELECT * INTO [" & Fich & "] FROM 6112Bis"
'        End If
    
TableExiste = False
For Each Tbl In CurrentDb.TableDefs
    Fich = Left(Fichier, Len(Fichier) - 4)
    TableName = Tbl.Name
    
    If TableName = Fich Then
    ' La table a été trouvée...
        TableExiste = True
    End If
Next
If TableExiste = False Then
    CurrentDb.Execute "SELECT * INTO [" & Fich & "] FROM 6112Bis"
     
     'requête pour extraire les données de la Feuil1
        oProdRS.Open "SELECT * FROM [Sheet1$]", Cn, adOpenStatic
        oRS.Open "Select * from " & TableName & "", oConn, adOpenKeyset, adLockOptimistic
        
        ' --- Transfert des données dans la base ---
            Do While Not (oProdRS.EOF)

                oRS.AddNew
                    For j = 0 To oRS.Fields.Count - 1
                    oRS.Fields(j) = oProdRS.Fields(j).Value                    Next j
                oRS.Update
                oProdRS.MoveNext
            Loop
        oProdRS.Close
        oRS.Close
End If
    
    
    
    'Fermeture de la connection au classeur Excel
    Cn.Close
Fichier = Dir

Loop

oConn.Close
Set oRS = Nothing
'Fermeture de la connection Access
Set oConn = Nothing
End Sub

Aurais-je fait une bêtise quelque part ?

[Nitromard]

Bon j'ai trouvé mon erreur, c'était dans le nom d'un de mes fichiers Excel qui s'appelait : picmod - Copy.
Soit c'est l'espace qui posait problème, soit c'est le -, auriez-vous une solution pour que le programme accepte ce type de nom de fichier?