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

**Nitromard** · 22/04/2011, 10h26

Bonjour,

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

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
 
        '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 :

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

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

**pgz** · 22/04/2011, 11h13

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 :

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

[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 :

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

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

**Nitromard** · 22/04/2011, 11h41

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 :

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

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 :

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

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

J'imagine ?

**Nitromard** · 22/04/2011, 11h45

J'ai donc ça :

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
 
            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...

**Nitromard** · 22/04/2011, 18h10

Rebonjour,

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

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
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.

**Nitromard** · 26/04/2011, 14h58

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 :

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
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

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

VBA Access

Discussions similaires

Partager

Partager