Discussion :

[BATtheBARGE]

Bonjour à tous,

Voilà je requiers votre aide car après plusieurs heures de recherches sur différents forum je ne trouve pas de solution à mon problème.

Je m'explique :

J'ai un fichier Excel avec plusieurs feuilles de données ainsi qu'un fichier Access avec une base de donnée déjà créée.

J'aimerais que via le clique d'un bouton sur Excel une série de requetes sql s'effectuent pour sauvegarder mes données dans les tables de la base de données Access grâce à du code vba et sql.

Par exemple sous mon code vba Excel un truc du genre :

Code sql :

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

INSERT INTO tb_XXX VALUES (Cellule A1.Feuil1), (Cellule A2.Feuil1)...

Mais je n'ai aucune idée de comment relier mes fichiers Excel et Access afin que je puisse exécuter ce genre de requêtes.

Si vous pouviez m'éclairer je vous en serait très reconnaissant.

Merci d'avance.

B.

[Mr Poulpe]

Bonjour,

Tu dois pouvoir utiliser le pilote OLEDB. En faisant rapidement une recherche sur internet, j'ai réussi à bricoler le code suivant, pour faire un insert:

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
Sub sbADO2()
Dim sSQLQry As String
Dim ReturnArray
 
Dim Conn As New ADODB.Connection
Dim mrs As New ADODB.Recordset
 
Dim sconnect As String
 
sconnect = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=C:\Users\Moi\Documents\Base de données Web - Biens.accdb;Persist Security Info=False;"
 
Conn.Open sconnect
 
        sSQLSting = "INSERT INTO Biens (Commentaires, Fabricant, Élément)" & _
       "VALUES               ('CB'    , 'Carte bancaire', 'test')"
 
    mrs.Open sSQLSting, Conn
Conn.Close
 
End Sub

Avec ça tu rajoutes une ligne dans la table 'Biens', avec dans les champs commentaires, 'fabricant', et 'Élément' les valeurs 'CB', 'Carte bancaire' et 'test' respectivement.

Note : Il est nécéssaire d'activer la référence Microsoft ActiveX Data Objects 2.8 dans l'onglet "outils" de VBA.

A toute fin utile, un exemple avec une requête de type "SELECT" :

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
Sub sbADO()
Dim sSQLQry As String
Dim ReturnArray
 
Dim Conn As New ADODB.Connection
Dim mrs As New ADODB.Recordset
 
Dim sconnect As String
 
sconnect = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=C:\Users\Moi\Documents\Base de données Web - Biens.accdb;Persist Security Info=False;"
 
 
Conn.Open sconnect
    sSQLSting = "SELECT * From [Biens]"
    mrs.Open sSQLSting, Conn
        ActiveSheet.Range("A2").CopyFromRecordset mrs
    mrs.Close
Conn.Close
 
End Sub

En espérant que ça puisse t'aider,

Mr Poulpe

[BATtheBARGE]

Bonjour Mr Poulpe,

Oui c'est exactement ce que je cherche, j'ai fais quelques test et tout semble fonctionner.

Juste une question, une partie reste un peu flou encore. Si je fais une requête "SELECT..." est-ce que je peux stocker le résultat de la requête dans une variable?

Merci encore pour ton aide!

B.

[Mr Poulpe]

En effet, tu peux copier le résultat de la requête dans un tableau. Dans l'exemple précédent :

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
Sub sbADO()
Dim sSQLQry As String
Dim ReturnArray
 
Dim Conn As New ADODB.Connection
Dim mrs As New ADODB.Recordset
 
Dim sconnect As String
 
sconnect = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=C:\Users\Moi\Documents\Base de données Web - Biens.accdb;Persist Security Info=False;"
 
 
Conn.Open sconnect
    sSQLSting = "SELECT * From [Biens]"
    mrs.Open sSQLSting, Conn
        ReturnArray = mrs.GetRows
    mrs.Close
Conn.Close
 
End Sub

J'en profite pour mettre le lien du code original :

http://analysistabs.com/excel-vba/ad...ting-database/

Cordialement,

Poulpe

[BATtheBARGE]

Merci de ta réponse, j'ai toutefois trouvé une alternative qui convenait plus aux besoin de mon code en parcourant le recordset et qui fonctionne.

Voici mon code à présent :

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
 
Private Sub CommandButton3_Click()
 
Dim sSQLQry As String
Dim ReturnArray
Dim Dern As Integer
Dim resu As Integer
 
Dim Conn As New ADODB.Connection
Dim mrs As New ADODB.Recordset
 
Dim sconnect As String
 
resu = 0
sconnect = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=C:\Users\Baptiste\Documents\BD_LACHATSA.accdb;Persist Security Info=False;"
 
Conn.Open sconnect
 
'Site de production de la Malcôte
Dern = Sheets("Malcôte").Range("W" & Rows.count).End(xlUp).Row ' = compteur de lignes du tableau
 
'Boucle parcoursant le tableau excel
For i = 2 To Dern
 
'requete select de la date et du site de production dans la table "tb_principale" de la base de données
sSQLSting = "SELECT date_princi, site_princi  From [tb_principale]"
mrs.Open sSQLSting, Conn
 
mrs.MoveFirst 'première position du recordset
 
'Boucle parcourant les résultats de la requete contenu dans le recordset (mrs)
Do While mrs.EOF = False
If mrs(date_princi) = Sheets("Malcôte").Range("W" & i).Value Then
    If mrs(site_princi) = "Malcôte" Then
        resu = 1 'contrôle si l'écriture existe déjà
    End If
End If
 
mrs.MoveNext 'passage au résultat suivant du recordset (mrs)
Loop 'tour suivant de la boucle "Do While"
 
If resu = 0 Then 'Si l'écriture n'éxiste pas
 
'requete "Insert"
sSQLSting = "INSERT INTO tb_principale (date_princi, remarque_princi, visa_princi, site_princi)" & _
       "VALUES               ('" & Sheets("Malcôte").Range("W" & i).Value & "'    , '" & Sheets("Malcôte").Range("U" & i).Value & " ', '" & Sheets("Malcôte").Range("V" & i).Value & "' , 'Malcôte')"
mrs.Open sSQLSting, Conn
 
End If
 
resu = 0 ' Contrôle remis à 0
 
Next 'Incrémentation de la boucle "FOR"
 
Conn.Close
 
End Sub

Cependant j'ai une erreur dont je ne trouve pas la provenance :

"Erreur d'exécution '3021' : Erreur définie par l'application ou par l'objet"

Je ne comprend pas trop ce que cela signifie. J'ai essayé de mettre des parties de mon code en commentaire mais sans succès... Je ne trouve pas d'où provient l'erreur!

Si qqun remarque une faute ou autre, votre aide serait la bienvenue!

Merci,

B.

[Mr Poulpe]

Pourrais-tu dire à quelle ligne l'erreur se produit?

[BATtheBARGE]

Le problème vient de là... Il ne me surligne rien, ne m'indique rien... juste le message d'erreur!

P.S : L'aide en ligne d'office concernant cette erreur n'est en plus d'aucune utilité....

[Mr Poulpe]

Hmmm... Je pense que tu es supposé fermer ton recordset une fois que tu l'as ouvert avant de le réouvrir. Essaie peut être ç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
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
Private Sub CommandButton3_Click()
 
Dim sSQLQry As String
Dim ReturnArray
Dim Dern As Integer
Dim resu As Integer
 
Dim Conn As New ADODB.Connection
Dim mrs As New ADODB.Recordset
 
Dim sconnect As String
 
resu = 0
sconnect = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=C:\Users\Baptiste\Documents\BD_LACHATSA.accdb;Persist Security Info=False;"
 
Conn.Open sconnect
 
'Site de production de la Malcôte
Dern = Sheets("Malcôte").Range("W" & Rows.count).End(xlUp).Row ' = compteur de lignes du tableau
 
'Boucle parcoursant le tableau excel
For i = 2 To Dern
 
'requete select de la date et du site de production dans la table "tb_principale" de la base de données
sSQLSting = "SELECT date_princi, site_princi  From [tb_principale]"
 
mrs.Open sSQLSting, Conn
 
mrs.MoveFirst 'première position du recordset
 
'Boucle parcourant les résultats de la requete contenu dans le recordset (mrs)
Do While mrs.EOF = False
If mrs(date_princi) = Sheets("Malcôte").Range("W" & i).Value Then
    If mrs(site_princi) = "Malcôte" Then
        resu = 1 'contrôle si l'écriture existe déjà
    End If
End If
 
mrs.MoveNext 'passage au résultat suivant du recordset (mrs)
Loop 'tour suivant de la boucle "Do While"
mrs.Close
 
If resu = 0 Then 'Si l'écriture n'éxiste pas
 
'requete "Insert"
sSQLSting = "INSERT INTO tb_principale (date_princi, remarque_princi, visa_princi, site_princi)" & _
       "VALUES               ('" & Sheets("Malcôte").Range("W" & i).Value & "'    , '" & Sheets("Malcôte").Range("U" & i).Value & " ', '" & Sheets("Malcôte").Range("V" & i).Value & "' , 'Malcôte')"
 
mrs.Open sSQLSting, Conn
mrs.Close
End If
 
resu = 0 ' Contrôle remis à 0
 
Next 'Incrémentation de la boucle "FOR"
 
Conn.Close
 
End Sub

[Invité]

Bonjour,
je présume que tu veux insérer les valeur qui existe dans Excel et pas dans Access!

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
DerL = Sheets("Malcôte").Range("W" & Cells.Rows.Count).End(xlUp).Row
For i = 2 To DerL
 sSQLSting = "SELECT * From [tb_principale] Where date_princi=#" & Sheets("Malcôte").Range("W" & i).Value & "# and site_princi = 'Malcôte';"
 mrs.Open sSQLSting, Conn
 If mrs.EOF = True Then
    mrs.AddNew
    mrs!date_princi = Sheets("Malcôte").Range("W" & i).Value
    mrs!remarque_princi = Sheets("Malcôte").Range("U" & i).Value
    mrs!visa_princi = Sheets("Malcôte").Range("V" & i).Value
    mrs!site_princi = "Malcôte"
    mrs.Update
 End If
 mrs.Close
Next

[BATtheBARGE]

Merci pour votre aide,

@Mr Poulpe

J'ai remplacé le code mais malheureusement le message d'erreur apparaît toujours!

@rdurupt

Je ne suis pas certain de ce qu'es supposé effectuer ce code . Je ne connais pas grand chose niveau ADO et OLE... Je vais tester le code que tu m'as proposé on verra bien!

P.S : J'ai essayé le code, malheureusement j'ai une autre erreur : "Erreur d'exécution '-2147217913 (80040e07)' : Erreur Automation

Le but que je cherche à atteindre avec mon code est de parcourir les lignes de mon tableau excel, si aucune entrée contenant la même date et le même site ne correspondent à un enregistrement de la bdd Access (comparé grâce aux résultats de la requête select), il doit faire un insert dans la bdd Access. (il évite les doublons enfait)


Merci encore pour votre précieuse aide!

[Invité]

ce code est sensé faire exactement ce que tu viens de dire. sur quel ligne l'erreur?

[BATtheBARGE]

Comme pour l'autre message, il n'y a pas d'autre indication que le message d'erreur!

P.S :

Sinon j'ai remarqué d'où proviendrait l'erreur de mon code principal :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
'Boucle parcoursant le tableau excel
For i = 1 To 1 'Dern
MsgBox i '!!! OK !!!
'requete select de la date et du site de production dans la table "tb_principale" de la base de données
sSQLSting = "SELECT date_princi, site_princi  From [tb_principale]"
MsgBox sSQLSting '!!! OK !!!

mrs.Open sSQLSting, Conn '!!!! ERREUR ICI!!!

MsgBox mrs(site_princi) '!!! PAS OK !!!

mrs.MoveFirst 'première position du recordset

Quand je fais un MsgBox de la requête, elle s'affiche, mais ensuite quand je fais la MsgBox en dessous de l'exécution de la requete et que j'essaie d'afficher un résultat... le message d'erreur apparaît... Pourtant ma requête semble correcte au niveau des éléments indiqués, une erreur de syntaxe peut-être? Je ne vois pas...

[Invité]

et juste ça ça fonctionne?

Code :

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

1
2
 sSQLSting = "SELECT * From [tb_principale] ;"
 mrs.Open sSQLSting, Conn

[BATtheBARGE]

Toujours un message d'erreur, par contre le code à changé , '3021' est devenu '3265', toujours une erreur définie par l'application ou par l'objet...

C'est assez frustrant, surtout que j'ai l'impression de toucher au but mais qu'il y a une petite erreur quelque part que je ne vois pas!

En tout cas, merci à tous pour votre temps! J'apprécie beaucoup!

[Invité]

à ce niveau là; soit la connexion à ta base de données ne fonctionne pas mais tu devrais avoir une erreur à la connexion; soit la table tb_principale n'existe pas dans ta base de données

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
 
Dim Conn As New ADODB.Connection
Dim mrs As New ADODB.Recordset
 
Dim sconnect As String
 
resu = 0
sconnect = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=C:\Users\Baptiste\Documents\BD_LACHATSA.accdb;Persist Security Info=False;"
 
Conn.Open sconnect
 
 sSQLSting = "SELECT * From [tb_principale] ;"
 mrs.Open sSQLSting, Conn

[BATtheBARGE]

Ce qui est étrange, c'est qu'avant de faire la requête de select et mes boucles pour faire les test, en utilisant seulement le premier code de Mr Poulpe, je pouvait faire un Insert dans la table :

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
 
Sub sbADO2()
Dim sSQLQry As String
Dim ReturnArray
 
Dim Conn As New ADODB.Connection
Dim mrs As New ADODB.Recordset
 
Dim sconnect As String
 
sconnect = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=C:\Users\Baptiste\Documents\BD_LACHATSA.accdb;Persist Security Info=False;"
 
Conn.Open sconnect
 
sSQLSting = "INSERT INTO tb_principale (date_princi, remarque_princi, visa_princi, site_princi)" & _
"VALUES ('" & Sheets("Malcôte").Range("W2").Value & "', 'a', 'b', 'c')"
 
    mrs.Open sSQLSting, Conn
Conn.Close
 
End Sub

Ce code là fonctionne très bien, donc logiquement, la base de donnée et la table sont en ordre...


P.S : Étrangement, en remettant le code d'origine, j'arrive à aller plus loin :

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
mrs.Open sSQLSting, Conn 'Maintenant il le passe


MsgBox "TEST1" '!!! OK !!!

'mrs.MoveFirst 'première position du recordset
MsgBox "TEST2" '!!! OK !!!
'Boucle parcourant les résultats de la requete contenu dans le recordset (mrs)
Do While mrs.EOF = False
MsgBox "TEST3" '!!! OK !!!

If mrs(date_princi) = Sheets("Malcôte").Range("W" & i).Value Then
MsgBox "TEST4" '!!! PAS OK !!!
    If mrs(site_princi) = "Malcôte" Then
    MsgBox "TEST5" '!!! PAS OK !!!
        resu = 1 'contrôle si l'écriture existe déjà
    End If
End If

Là je suis complètement perdu...

[Mr Poulpe]

Code :

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

1
2
3
4
5
6
7
If mrs(date_princi) = Sheets("Malcôte").Range("W" & i).Value Then
MsgBox "TEST4" '!!! PAS OK !!!
    If mrs(site_princi) = "Malcôte" Then
    MsgBox "TEST5" '!!! PAS OK !!!
        resu = 1 'contrôle si l'écriture existe déjà
    End If
End If

Manque pas des guillemets dans ce bout de code pour les noms de champs?

[BATtheBARGE]

Bonjour, voilà mon développement à avancé et j'ai réuci à régler le problème précédent. Mon INSERT se fait correctement en respectant les boucles et conditions que je lui imposait.

Cepandant, à présent j'essaie d'ajouter des données dans d'autres tables, et là c'est le drame...

Je lance une requete SELECT (voir texte en vert), elle passe! Mais après toutes les requetes que je lance, même une toute simple... impossible! Excel crie!

J'ai tenté de faire un mrs.close, un mrs.delete, un Conn.close, un peu tout en fait, mais rien n'y fait, je ne peux pas aligner dans le bout de code ci dessous 2 requêtes... J'ai peut-être loupé quelque chose... si je pouvait encore faire appel à vos connaissances, ce serait génial!

Merci d'avance.

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
If Sheets("Malcôte").Range("D" & i).Value <> 0 Or Sheets("Malcôte").Range("E" & i).Value <> 0 Or Sheets("Malcôte").Range("F" & i).Value <> 0 Then

sSQLSting = "SELECT pk_matiere  From [tb_matiere] WHERE nom_matiere = 'Chaille'"

mrs.Open sSQLSting, Conn ' PREMIERE REQUETE OK

pk = mrs!pk_matiere

sSQLSting = "SELECT pk_princi From [tb_principale] " 'WHERE date princi =  " & CDate(Sheets("Malcôte").Range("W" & i).Value) & "" 

mrs.Open sSQLSting, Conn 'ICI IL CRIE

pk2 = mrs!pk_princi

sSQLSting = "INSERT INTO tb_production (fk_matière, propre_prod, st_prod, concassage_prod, fk_princi_prod)" & _
"VALUES (" & pk & "," & Sheets("Malcôte").Range("D" & i).Value & "," & Sheets("Malcôte").Range("E" & i).Value & "," & Sheets("Malcôte").Range("F" & i).Value & "," & pk2 & ")"
mrs.Open sSQLSting, Conn

Else
MsgBox "Pas Entré"

End If
'mrs.Close

End If

[parmi]

sSQLSting = "SELECT pk_princi From [tb_principale] " 'WHERE date princi = " & CDate(Sheets("Malcôte").Range("W" & i).Value) & ""

enlève le guillemet et l'apostrophe avant le WHERE
Et habitue-toi à déclarer les lignes Excel en Long, pas Integer...

[Mr Poulpe]

Peux-tu essayer de relancer EXACTEMENT la même commande mrs.Open sSQLSting, Conn juste après l'avoir exécuté une première fois et nous dire si Excel couine la deuxième fois? Auquel cas il s'agirait bien d'un problème sur le recordset qu'il faudrait "nettoyer" avant de le réutiliser (ce qui permet d'exclure la possibilité d'un problème sur la requête SQL en elle même)