Comment importer des données Excel vers Access avec VBA Access ?

Version imprimable

15/04/2011, 13h05
Nitromard

Comment importer des données Excel vers Access avec VBA Access ?

Bonjour a tous,

Je vais vous exposer mon petit problème en bref :

Je dois trouver un programme VBA Access qui analyse, dans un dossier général, des sous-dossiers en les identifiants par leur nom et ensuite analyse leur contenu.
Dans chaque sous-dossier, il y a deux types de fichiers excel qui ont chacun une structure particulière. (type NAV et type Fonds où tous les fichiers excel NAV ont la mm structure et tous les fichiers Fonds aussi)
Si le fichier excel comporte le nom NAV : en extraire les données dans une table d'une base de données Access, en évitant les doublons.
Si le fichiers excel comporte le mot Fonds : en extraire les données dans une autre table de la même base de données, tout en évitant également les doublons.

En fait je ne demande pas de me faire tout ça, je cherche juste un moyen d'extraire des données de plusieurs fichiers excel vers Access (a partir de VBA Access) vers une base de données déja existante (c'est a dire a la suite des données de la base de données). Et si possible en évitant les doublons.

Je pensais faire une boucle avec la fonction TransferSpreadsheet, mais j'ai aucune idée de comment le faire ^^.

Quelqu'un pourrait-il m'aider?
15/04/2011, 13h33
pgz

Bonjour.

Perso, je n'utiliserais pas de commande d'importation. Deux solutions de principe :

1. Rst sur claseur fermé. Si tes classeurs contiennent des données disposées proprement en tableaux, tu peux ouvrir un jeu d'enregistrement ADO ou DAO sur chaque classeur XL qui peut rester fermer.

La manipulation du jeu d'enregistrement te permettra de renseigner les tables.

2. Variable tableau avec classeur ouvert. Si tes données sont un peu dispersées, tu ne couperas pas à l'ouverture de chaque classeur. Tu peux utiliser des variables tableaux à 2 dimensions pour charger des zones de données.

La manipulation des variables tableaux te permettra de renseigner les tables.

Cordialement,

PGZ
15/04/2011, 14h15
Nitromard

Ok, donc je pencherais plutôt vers la 1ère solution, les classeurs excel sont bien rangés par colonnes, chaque classeur ayant les mm colonnes (sauf pour les deux types différents bien sûr).
Il faudrait effectivement que je puisse extraire toutes les données en laissant les classeurs fermés.
Il faudrait alors que je fasse une boucle sur le nom du classeur(NAV ou Fond), en fonction de cela, les données seront placées dans l'une des deux tables Access. (en évitant les doublons dans les 2 cas)
Ensuite entourer ça d'une boucle qui "boucle" sur les sous-dossiers.

Dites-moi si vous voyez quelque chose qui n'irait pas dans mon raisonnement.

Maintenant je dois donc essayer de comprendre comment fonctionne les plateformes DAO ou ADO ^^. Ou bien y aurait-il une solution générale existante que je n'aurais pas encore vue sur le net(avec ADO ou DAO bien sûr)? (j'ai déjà fait le tour des forums pour trouver un "simple" programme VBA Access qui extrait un ensemble de données de plusieurs fichiers Excel vers Access, pas moyen d'en trouver un correct...)

Quelqu'un aurait-il déjà du code pour extraire un fichier? (ou plusieurs)
15/04/2011, 16h12
pgz

Re,

Sur DVP il y a beaucoup de ressources.
Regarde le tuto de SilkyRoad Lire et écrire dans des classeurs fermés

Reviens quand tu auras commencé ton code et si tu rencontres des pb.

Cordialement,

PGZ

Bonjour,

J'ai commencé a taper du code pour utiliser ADO mais là je reste bloqué, je ne sais pas comment prendre des données excel et les mettre dans access...

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
 
Sub ExtractDataFromExcel()
    Dim Cn As ADODB.Connection
    Dim Fichier As String
    Dim NomFeuille As String, texte_SQL As String
    Dim Rst As ADODB.Recordset
 
    'Définit le classeur fermé servant de base de données
    Fichier = "C:\Users\qdeutschle\Desktop\Work\Données\Folder\picmod2.xls"
    'Nom de la feuille dans le classeur fermé
    NomFeuille = "Sheet4"
 
    Set Cn = New ADODB.Connection
 
    '--- Connection ---
    With Cn
        .Provider = "Microsoft.Jet.OLEDB.4.0"
        .ConnectionString = "Data Source=" & Fichier & _
            ";Extended Properties=Excel 8.0;"
        .Open
    End With
    '-----------------
 
    'Définit la requête.
    '/!\ Attention à ne pas oublier le symbole $ après le nom de la feuille.
    texte_SQL = "SELECT * FROM [" & Sheet4 & "$]"
 
    Set Rst = New ADODB.Recordset
    Set Rst = Cn.Execute(texte_SQL)
 
 
 
    '--- Fermeture connexion ---
    Cn.Close
    Set Cn = Nothing
 
End Sub

J'aiemerais déja comprendre et réussir mon code pour une feuille excel après je réfléchirais comment faire avec plusieurs.

Sinon j'avais trouvé une autre sorte de code pour extraire des données, mais là encore je suis bloqué car je n'arrive pas à sélectionner la colonne entière au lieu des cellules :

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
 
Private Sub importExcelData()
 
Dim xlApp As Excel.Application
Dim xlBk As Excel.Workbook
Dim xlSht As Excel.Worksheet
Dim dbRst As Recordset
Dim dbs As Database
Dim SQLStr As String
 
Set dbs = CurrentDb
Set xlApp = Excel.Application
Set xlBk = xlApp.Workbooks.Open("C:\Users\qdeutschle\Desktop\Work\Données\Folder\picmod2.xls")
Set xlSht = xlBk.Sheets(1)
 
SQLStr = "CREATE TABLE excelData(columnOne TEXT, columnTwo TEXT)"
 
DoCmd.SetWarnings False
 
DoCmd.RunSQL (SQLStr)
 
Set dbRst = dbs.OpenRecordset("excelData")
 
dbRst.AddNew
 
xlSht.Range("A2").Select
 
dbRst.Fields(0).Value = xlSht.Range("A2").Value
 
xlSht.Range("B2").Select
 
dbRst.Fields(1).Value = xlSht.Range("B2").Value
 
dbRst.Update
 
dbRst.Close
 
dbs.Close
 
xlBk.Close
 
End Sub

Sinon j'ai trouvé cette procédure, mais je n'arrive pas à la faire tourner...
Elle est censer faire ça :
boucle sur tous les classeurs d'un répertoire sans les ouvrir et transfert les données de la Feuil1 vers une table Access (Table1).

L'exemple suppose que
Tous les onglets portent le même nom.
Les classeurs sont structurés comme une vraie base (pas de données éparpillées) et de structure identique à la base Access (nombre de colonne et type de données adaptés:date,texte,numerique...etc...)

la procédure nécessite d'activer la référence Microsoft ActiveX Data Objects x.x Library

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
 
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
 
'------------------------------------------------------
'Connection à la Base Access
Set oConn = New ADODB.Connection
oConn.Open "Provider='Microsoft.Jet.OLEDB.4.0';" & _
"Data Source= 'C:\maBase.mdb';"
 
'les données seront placés dans Table1
Set oRS = New ADODB.Recordset
oRS.Open "Select * from Table1", oConn, adOpenKeyset, adLockOptimistic
'------------------------------------------------------
 
'Boucle sur les classeurs Excel du répertoire cible
Repertoire = "C:\Documents and Settings\mimi\dossier\general\excel\Nomdossier"
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;"""
 
    'requête pour extraire les données de la Feuil1
    oProdRS.Open "SELECT * FROM [Feuil1$]", Cn, adOpenStatic
 
    ' --- 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
    '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

19/04/2011, 12h13
pgz

Bonjour.

Dans ta première prcédure ADO tu as un jeu d'enregistrement Rst qui contient les données du classeur XL fermé. Il te reste à ouvrir un autre jeu d'enregistrement sur la table Access pour y ajouter les données de Rst.

Ce que tu fais dans le dernier code que tu montres. EN plus ce nouveau code balaie tous les classeurs d'un répertoire. Ce code semble correct. Quel est le problème que tu rencontres?

Cordialement,

PGZ

Je te donne le code modifié avec mes données :
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 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 '------------------------------------------------------ 'Connection à la Base Access Set oConn = New ADODB.Connection oConn.Open "Provider='Microsoft.ACE.OLEDB.12.0';" & _ "Data Source= 'Libraries\Documents\Database2.mdb';" 'les données seront placés dans Table1 Set oRS = New ADODB.Recordset oRS.Open "Select * from Sheet3", oConn, adOpenKeyset, adLockOptimistic '------------------------------------------------------ '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;""" 'requête pour extraire les données de la Feuil1 oProdRS.Open "SELECT * FROM [Sheet4$]", Cn, adOpenStatic ' --- 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 '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
Je met en fait ce programme dans un module sous access avec les références : Microsoft ActiveX Data Objects.6.0 Library
Microsoft ADO Ext.6.0 for DDL and Security
J'ai déja essayé en enlevant la 2ème référence que je t'ai donné mais ça me fait la même erreur qui est :

run-time error '-2147467259(80004005)' :
'C:\users\myname\documents\libraries\documents\database2.accdb' is not a valid path. Make sure that the path name is spelled correctly and that you are connected to the server on which the file resides.

En fait, ce code est dans un module de ma base access que je voudrais enrichir avec les fichiers excel. J'ai déja une table avec les mm noms que les colonnes de mes fichiers excel.(ici tout est dans database2, le code et la table)

Je viens d'essayer autre chose, j'ai remplacé :
'Libraries\Documents\Database2.mdb'
Par :
'C:\Users\myname\Desktop\Database2.accdb'

Et cela me donne cette erreur :
run-time error '-2147467259(80004005)' :
The database has been placed in a state by user 'Admin' on machine 'LUACGL8781' that prevents it from being opened or locked.

Voila, je ne sais vraiment pas a quoi cela correspond...Merci d'avance pour ton aide !

19/04/2011, 15h13
Nitromard
Bon j'ai plus les même messages d'erreur qui apparaissent, j'ai maintenant :

Run-time error '-2147467259(80004005)':
Unrecognized database format 'C:\Users\qdeutschle\Desktop\ExtractADO.accdb'
Code:

1 2 3 4 Set oConn = New ADODB.Connection oConn.Open "Provider='Microsoft.Jet.OLEDB.4.0';" & _ "Data Source= 'C:\Users\qdeutschle\Desktop\ExtractADO.accdb';"
Voila ce que j'ai changé par rapport au code d'avant (il ne connaissait pas le provider que je lui donnais alors j'ai gardé celui du code de base)

Bonjour.

Si ton code est dans la BD, tu remplaces
Code:

1 2 3 4 'Connection à la Base Access Set oConn = New ADODB.Connection oConn.Open "Provider='Microsoft.ACE.OLEDB.12.0';" & _ "Data Source= 'Libraries\Documents\Database2.mdb';"
Par

Code:

Set OConn = CurrentProject.Connection

Cordialement,

PGZ

19/04/2011, 15h46
Nitromard

Super merci beaucoup !

Le programme fonctionne très bien ^^ !

Bon je vais maintenant tenter de faire mes gestions d'erreur et mes boucles sur les folder et éviter les doublons seul ^^ (sauf bien sûr si vous avez quelques conseils à me donner)

Encore merci pour votre aide,

Cordialement,

Nitromard
19/04/2011, 19h12
pgz

Bonsoir.

Il faudrait savoir comment tu définis les doublons, c'est-à-dire quels champs ont des valeurs identiques : 1, 2, n, tous?

Après ce n'est pas trop difficile.

Cordialement,

PGZ
21/04/2011, 08h44
Nitromard

Bonjour,

Donc je n'ai pas de clé primaire dans ma table, pour l'instant ce n'est pas dans mon objectif de créer une clé primaire, donc les doublons ne sont pas supprimés automatiquement.
Ensuite j'ai ma 1ère colonne date qui est identique 642 fois(et il faudrai que je la garde pour plus tard car j'aurais des dates différentes mais qui se répèteront aussi bcp de fois), ensuite une colonne code service avec 3 ou 4 différents codes. Une colonne sécurity name qui peut être répétée plusieurs fois.
Ensuite une quantité qui est souvent différente mais qui peut aussi se répéter.
Une date de maturité qui n'existe pas toujours.
Un code pays qui se répète aussi.
Une valeur marchée qui change souvent mais qui peut aussi être identique.
Un strike souvent nul.
Et enfin deux dernière colonne qui peuvent se répéter aussi.
En gros, toute mes colonnes se répètent ou sont susceptibles de se répéter, mais je pense que chaque ligne est indépendante.

Donc le mieux serait soit de comparer une ligne a toute les autres pour voir si elle se répète, ou bien de faire une clé primaire...

Je pencherais du coup pour la clé primaire : plus rapide et consomme moins de temps j'imagine.

Qu'en pensez-vous?

Cordialement,

Nitromard
21/04/2011, 09h50
pgz

Bonjour.

DOnc pour toi 2 enregistrements constituent 1 doublon si tous leurs champs contiennent des valeurs identiques? Autrement dit, 2 enregistrements qui contiennent des valeurs diffrentes dans 1 champ ne sont pas des doublons?

PGZ
21/04/2011, 10h12
Nitromard

Oui c'est exactement ça.
En fait j'ai fait quelques tests :
-Si j'ai une clé primaire : le programme s'arrête lorsqu'il trouve un doublon et il ne prends pas les données qui viennent ensuite.

-Si je n'ai pas de clé primaire : le programme prend toutes les données mm les doublons (comme définis à mon sens). Et donc je veux éviter ces doublons ou bien faire une clé pour chaque ligne.

Mais cela comporte un risque de faire une clé, en fait comme c'est le client qui envoi les données et que je crée une clé pour chaque ligne, si lui a commis une erreur et a recopier 2 fois la mm ligne alors si je ne le vois pas j'aurais un doublon a proprement dit mais qui aura une clé différente de son jumeau...

Bonjour.

Avant d'ajouter un enregistrement à la table, tu dois t'assurer que ce n'est pas un doublon, c'est-à-dire que le n-uples des nouvelles valeurs n'est pas déjà en table.
Pour cela, il suffirait de faire une Find sur le jeu d'enregistrements de la table. Le problème c'est que le recordset ADO n'accepte pas les recherches multicritères.

Une solution serait donc d'ouvrir plutôt une jeu d'enregistrements ADO qui lui permet ces recherches. (He oui, DAO a aussi des vertus!)
Une autre solution est d'utiliser la méthode Filter du jeu d'enregistrements ADO. Cette solution donnerait

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
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, sCritere as string
 
'------------------------------------------------------
'Connection à la Base Access
Set OConn = CurrentProject.Connection
 
'les données seront placés dans Table1
Set oRS = New ADODB.Recordset
oRS.Open "Select * from Sheet3", oConn, adOpenKeyset, adLockOptimistic
'------------------------------------------------------
 
'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;"""
 
    'requête pour extraire les données de la Feuil1
    oProdRS.Open "SELECT * FROM [Sheet4$]", Cn, adOpenStatic
 
    ' --- Transfert des données dans la base ---
    Do While Not (oProdRS.EOF)
        'construction de la chaîne de critères par quelques exemples
            'champ numérique
            sCritere = "(" & oRS(0).Name &  " = " & oProdRS(0).value & ")"
            'champ texte
            sCritere = scritere & " And (" & oRS(1).Name & " = """ & oProdRS(1) & """)"
            'champ date
            sCritere = sCritere & " And (" & oRS(2).Name) & " = #" & Format(oProdRS(2),"mm/dd/yyyy") & "#)"
            'et ainsi de suite...
        oRS.Filter sCritere
        If oRS.recordCount = 0 then
            oRS.AddNew
                For j = 0 To oRS.Fields.Count - 1
                oRS.Fields(j) = oProdRS.Fields(j).Value
                Next j
            oRS.Update
        end if
        oRS.Filter = adFilterNone
        oProdRS.MoveNext
    Loop
    '-------------------------------------------
 
    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

Il faut construire soigneusement la chaîne sCritere, en tenant compte du type de données. Le code ci-dessus n'est pas opérant, c'est une illustration de l'idée.

Cordialement,

PGZ

21/04/2011, 15h51
Nitromard

Donc si je comprends bien, je dois construire une chaîne sCritere en fonction de chacune de mes colonnes, du coup il me lira les fichiers excel à travers ce filtre?
21/04/2011, 15h54
Nitromard

Donc ça c'est la solution (si elle fonctionne ^^) au problème de la talbe sans clé primaire.
Je pense que je serais quand même confronté au problème des tables avec clé primaire.
Quelle serait la démarche pour éviter que le programme ne se bloque sur chaque doublon? (j'imagine qu'il doit y avoir une commande ou une fonction qui permet ça?)

Bon voila ce que j'ai tapé du coup mais j'ai une erreur :

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
 
Option Compare Database
 
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, sCritere As String
 
'------------------------------------------------------
'Connection à la Base Access
Set oConn = CurrentProject.Connection
 
'les données seront placés dans Table1
Set oRS = New ADODB.Recordset
oRS.Open "Select * from Sheet3", oConn, adOpenKeyset, adLockOptimistic
'------------------------------------------------------
 
'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;"""
 
    'requête pour extraire les données de la Feuil1
    oProdRS.Open "SELECT * FROM [Sheet4$]", Cn, adOpenStatic
 
    ' --- Transfert des données dans la base ---
    Do While Not (oProdRS.EOF)
 
        'construction de la chaîne de critères par quelques exemples
            'champ numérique
            'sCritere = "(" & oRS(0).Name & " = " & oProdRS(0).Value & ")"
            'champ texte
            'sCritere = sCritere & " And (" & oRS(1).Name & " = """ & oProdRS(1) & """)"
            'champ date
            'sCritere = sCritere & " And (" & oRS(2).Name & " = #" & Format(oProdRS(2), "mm/dd/yyyy") & "#)"
            'et ainsi de suite...
 
            sCritere = "(" & oRS(0).Name & " = #" & Format(oProdRS(0), "mm/dd/yyyy") & "#)"
            sCritere = sCritere & " And (" & oRS(1).Name & " = """ & oProdRS(1) & """)"
            sCritere = sCritere & " And (" & oRS(2).Name & " = """ & oProdRS(2) & """)"
            sCritere = sCritere & " And (" & oRS(3).Name & " = " & oProdRS(3).Value & ")"
            sCritere = sCritere & " And (" & oRS(4).Name & " = #" & Format(oProdRS(4), "mm/dd/yyyy") & "#)"
            sCritere = sCritere & " And (" & oRS(5).Name & " = """ & oProdRS(5) & """)"
            sCritere = sCritere & " And (" & oRS(6).Name & " = " & oProdRS(6).Value & ")"
            sCritere = sCritere & " And (" & oRS(7).Name & " = " & oProdRS(7).Value & ")"
            sCritere = sCritere & " And (" & oRS(8).Name & " = " & oProdRS(8).Value & ")"
            sCritere = sCritere & " And (" & oRS(9).Name & " = " & oProdRS(9).Value & ")"
            sCritere = sCritere & " And (" & oRS(10).Name & " = " & oProdRS(10).Value & ")"
 
        oRS.Filter sCritere
        If oRS.RecordCount = 0 Then
            oRS.AddNew
                For j = 0 To oRS.Fields.Count - 1
                oRS.Fields(j) = oProdRS.Fields(j).Value
                Next j
            oRS.Update
        End If
        oRS.Filter = adFilterNone
        oProdRS.MoveNext
    Loop
    '-------------------------------------------
 
    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

Compile error :
Invalid Use of property.

Il me met le .Filter en surbriance...

21/04/2011, 17h33
pgz

Re,

Au temps pour moi, c'est :

Code:

oRS.Filter = sCritere

Je n'ai pas regardé le reste. Si tu as encore une erreur, fait un

Code:

Debug.Print sCritere

PGZ

Bonjour,

Alors je vous met le bout de programme que j'ai modifié dans mon programme qui fonctionne bien (en suivant vos conseils) :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
 
        'construction de la chaîne de critères:
 
            sCritere = "(" & oRS(0).Name & " = #" & Format(oProdRS(0), "mm/dd/yyyy") & "#)"
            sCritere = sCritere & " And (" & oRS(1).Name & " = """ & oProdRS(1) & """)"
            sCritere = sCritere & " And (" & oRS(2).Name & " = """ & oProdRS(2) & """)"
            sCritere = sCritere & " And (" & oRS(3).Name & " = " & oProdRS(3).Value & ")"
            sCritere = sCritere & " And (" & oRS(4).Name & " = #" & Format(oProdRS(4), "mm/dd/yyyy") & "#)"
            sCritere = sCritere & " And (" & oRS(5).Name & " = """ & oProdRS(5) & """)"
            sCritere = sCritere & " And (" & oRS(6).Name & " = " & oProdRS(6).Value & ")"
            sCritere = sCritere & " And (" & oRS(7).Name & " = " & oProdRS(7).Value & ")"
            sCritere = sCritere & " And (" & oRS(8).Name & " = " & oProdRS(8).Value & ")"
            sCritere = sCritere & " And (" & oRS(9).Name & " = " & oProdRS(9).Value & ")"
            sCritere = sCritere & " And (" & oRS(10).Name & " = " & oProdRS(10).Value & ")"
 
        Debug.Print sCritere
        oRS.Filter = sCritere

Alors j'ai une erreur du type :
Run-time error '3001' :
Arguments are of the wrong type, are out of acceptable range, or are in conflict with one another.

Et il me met dans la fenêtre d'execution :

Code:

1
2
 
(Date Nav = #01/01/2010#) And (Code Service = "BO") And (Security Name = "SAMPO ´A´") And (Quantité = 190000,00002) And (Date Maturity = ##) And (Security Ccy = "EUR") And (Mkt Value Ptf = 3809500) And (Strike = 0) And (Commitments Ptf Futurs andOptions = 0) And (Price Underlying = 0) And (Nav Net = 252125789,35)

J'ai bien revérifié si les données était bien du texte, des dates ou bien des nombres et c'est le cas, je les ai bien définies au départ.
Donc...je ne vois pas où est le problème.

Merci encore pour votre aide.

Cordialement,

Nitromard

Bonjour.

Je vois 2 types de pb :

orthographe de noms de champs
des valeurs Null ou vides

Orthographe : Les noms de champs en plusieurs mots ne passent pas. Je te propose de les mettre entre crochets, par exemple

Code:

[Code Service]

Valeurs Null ou vides, comme pour [Date maturity]. Pour chaque champ qui peut être null, il faut tester.

Exemple de mise en oeuvre de ces 2 règles, pour [Date maturity] :
Code:

1 2 3 4 5 If isNull(oProdRS) then sCritere = sCritere & " And isNull([" & oRS(4).Name & "])" Else sCritere = sCritere & " And ([" & oRS(4).Name & "] = #" & Format(oProdRS(4), "mm/dd/yyyy") & "#)" End if
Bonne journée,

PGZ

Ok, pour le prlbème d'espace entre les champs, je m'en débarasse directement avant de lancer le programme comme ça, j'aurais pas besoin de m'occuper de ça (soit je le supprime, soit je met _, sous access ainsi que dans mes fichiers excel), ensuite le seul champ qui peut être vide c'est date maturity alors je met la ligne de code :
Code:

1 2 3 4 5 6 If isNull(oProdRS) then sCritere = sCritere & " And isNull(" & oRS(4).Name & ")" Else sCritere = sCritere & " And (" & oRS(4).Name & " = #" & Format(oProdRS(4), "mm/dd/yyyy") & "#)" End if
A la place de la ligne :
Code:

1 2 sCritere = sCritere & " And (" & oRS(4).Name & " = #" & Format(oProdRS(4), "mm/dd/yyyy") & "#)"
J'imagine ?

J'ai donc ça :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
 
            sCritere = "(" & oRS(0).Name & " = #" & Format(oProdRS(0), "mm/dd/yyyy") & "#)"
            sCritere = sCritere & " And (" & oRS(1).Name & " = """ & oProdRS(1) & """)"
            sCritere = sCritere & " And (" & oRS(2).Name & " = """ & oProdRS(2) & """)"
            sCritere = sCritere & " And (" & oRS(3).Name & " = " & oProdRS(3).Value & ")"
 
                If IsNull(oProdRS) Then
                    sCritere = sCritere & " And isNull(" & oRS(4).Name & ")"
                Else
                    sCritere = sCritere & " And (" & oRS(4).Name & " = #" & Format(oProdRS(4), "mm/dd/yyyy") & "#)"
                End If
 
            sCritere = sCritere & " And (" & oRS(5).Name & " = """ & oProdRS(5) & """)"
            sCritere = sCritere & " And (" & oRS(6).Name & " = " & oProdRS(6).Value & ")"
            sCritere = sCritere & " And (" & oRS(7).Name & " = " & oProdRS(7).Value & ")"
            sCritere = sCritere & " And (" & oRS(8).Name & " = " & oProdRS(8).Value & ")"
            sCritere = sCritere & " And (" & oRS(9).Name & " = " & oProdRS(9).Value & ")"
            sCritere = sCritere & " And (" & oRS(10).Name & " = " & oProdRS(10).Value & ")"
 
        Debug.Print sCritere
        oRS.Filter = sCritere

Mais j'ai toujours la même erreur...

Rebonjour,

Bon j'ai un petit changement de programme en fait...
Voila mon nouveau programme : (c'est le mm un peu modifié)

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
 
Option Compare Database
 
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\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
 
    For Each Tbl In oConn.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
        'Else if dans nom du fichier NAV, refaire la mm chose
        'Else if 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

En fait le truc c'est qu'il doit me comparer le nom du fichier (qui d'après ce que j'ai compris s'écrit : nomfichier.xls) avec le nom de mes tables afin de les insérer dans les bonnes tables.

J'ai cherché un peu partout sur le net et j'ai réussis à taper ce code, mais il me dit l'erreur :
Arguments are of the wrong type...

En me surlignant : For Each Tbl In oConn.Tables

En fait j'aimerais que pour chaque table, il me compare le nom de la table avec le nom du fichier excel sélectionné, si ils ont le mm nom, on met les données dans la table, sinon on crée une table qui porte le nom du fichier.

Voila je ne sais pas quoi faire de nouveau avec cette erreur.

J'ai ajouté une nouvelle discussion pour ce sujet, comme il a plutôt dévié de sa fonction originelle.

Par contre j'ai toujours le problème des doublons...Mais cette fois j'ai besoin d'une solution pour une table avec une ou plusieurs clés primaires.

Je m'explique :
Lorsque le programme trouve un doublon, il s'arrête et me donne l'erreur :
The changes you requested to the table were not successful because they would create duplicate values in the index, primary key, or relationship. Chqnge the data in the field or fields that contain duplicate data, remove the index, or redefine the index to permit duplicate entries and try again.

Je vous donne tout de même le nouveau programme un peu modifié :

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
 
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
        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 " & 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
    Next Tbl
 
'Si pas de table du nom du fichier, créer une table
 
    'Fermeture de la connection au classeur Excel
    Cn.Close
Fichier = Dir
oConn.Close
Loop
 
 
Set oRS = Nothing
'Fermeture de la connection Access
Set oConn = Nothing
End Sub

Fuseau horaire GMT +2. Il est actuellement 05h39.