Excel et Access : Requêtes en VBA

Bonjour à tous,

Généralement je trouve facilement les réponses à mes questions cependant là, je bloque.

Dans le cadre d'un projet au travail, le service qualité m'a demandé de créer sous Excel une macro qui permettrait de lancer automatiquement la mise à jour des tables d'une base de données Access (de type .accdb).

La base de donnée est dans le même répertoire que le fichier Excel sur lequel je dois travailler, la macro sera lancée via un bouton sur une nouvelle feuille dans ce fichier Excel.

La requête en SQL sur Access est de cette forme :

Code:

---

1 2 3 4

INSERT INTO [Reception RMC] ( Mois, E_COD_PLANT_ID, E_COD_TRANSACTION_TYPE, E_DAT_UPDATE, E_COD_ADJ_REASON, E_NUM_TRANSACTION, E_COD_LOCATION, E_COD_PART, E_QTY_MOVEMENT, E_NUM_PUTAWAY, E_COD_WAREHOUSE ) SELECT DISTINCT Month([E_DAT_UPDATE]) AS Mois, DWRL1_DWT_MF001_INVENTORY_MOVEMENTS.E_COD_PLANT_ID, DWRL1_DWT_MF001_INVENTORY_MOVEMENTS.E_COD_TRANSACTION_TYPE, DWRL1_DWT_MF001_INVENTORY_MOVEMENTS.E_DAT_UPDATE, DWRL1_DWT_MF001_INVENTORY_MOVEMENTS.E_COD_ADJ_REASON, DWRL1_DWT_MF001_INVENTORY_MOVEMENTS.E_NUM_TRANSACTION, DWRL1_DWT_MF001_INVENTORY_MOVEMENTS.E_COD_LOCATION, DWRL1_DWT_MF001_INVENTORY_MOVEMENTS.E_COD_PART, DWRL1_DWT_MF001_INVENTORY_MOVEMENTS.E_QTY_MOVEMENT, DWRL1_DWT_MF001_INVENTORY_MOVEMENTS.E_NUM_PUTAWAY, DWRL1_DWT_MF001_INVENTORY_MOVEMENTS.E_COD_WAREHOUSE FROM DWRL1_DWT_MF001_INVENTORY_MOVEMENTS WHERE (((Month([E_DAT_UPDATE]))=[INDIQUER MOIS]) AND ((DWRL1_DWT_MF001_INVENTORY_MOVEMENTS.E_COD_PLANT_ID)="F1") AND ((DWRL1_DWT_MF001_INVENTORY_MOVEMENTS.E_COD_TRANSACTION_TYPE)="TRN") AND ((DWRL1_DWT_MF001_INVENTORY_MOVEMENTS.E_DAT_UPDATE)>#1/1/2014#) AND ((DWRL1_DWT_MF001_INVENTORY_MOVEMENTS.E_COD_ADJ_REASON) Like "009") AND ((DWRL1_DWT_MF001_INVENTORY_MOVEMENTS.E_COD_LOCATION)="ZZ_CEVALEP1" Or (DWRL1_DWT_MF001_INVENTORY_MOVEMENTS.E_COD_LOCATION)="ZZ_CEVALEP2" Or (DWRL1_DWT_MF001_INVENTORY_MOVEMENTS.E_COD_LOCATION)="ZZ_VELEP1" Or (DWRL1_DWT_MF001_INVENTORY_MOVEMENTS.E_COD_LOCATION)="ZZ_VELEP2" Or (DWRL1_DWT_MF001_INVENTORY_MOVEMENTS.E_COD_LOCATION)="ZZ_PACK_20" Or (DWRL1_DWT_MF001_INVENTORY_MOVEMENTS.E_COD_LOCATION)="ZZ_LEP1_LEP2"));

---

Lorsque je lance cette requête dans Access, il m'est demandé de rentrer le mot de passe de la base de donnée distante (Ici DWRL1_DWT) afin de me connecter, puis de renseigner le numéro du mois correspondant aux enregistrements que je souhaite ajouter dans la table "Reception RMC".

Le but sera de permettre aux personnes ayant accès à Excel de mettre à jour la BDD sans avoir à toucher à Access.

J'ai bien tenté quelque chose comme ça :

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15

Sub UpdateDB() Dim DataB As DAO.Database Dim InsertSQL, SelectSQL, FromSQL, WhereAndOrSQL As String   Set DataB = OpenDatabase(ThisWorkbook.Path & "\PPM PACKAGERS.accdb")   InsertSQL = "INSERT INTO [Reception RMC] ( Mois, E_COD_PLANT_ID, E_COD_TRANSACTION_TYPE, E_DAT_UPDATE, E_COD_ADJ_REASON, E_NUM_TRANSACTION, E_COD_LOCATION, E_COD_PART, E_QTY_MOVEMENT, E_NUM_PUTAWAY, E_COD_WAREHOUSE )" SelectSQL = "SELECT DISTINCT Month([E_DAT_UPDATE]) AS Mois, DWRL1_DWT_MF001_INVENTORY_MOVEMENTS.E_COD_PLANT_ID, DWRL1_DWT_MF001_INVENTORY_MOVEMENTS.E_COD_TRANSACTION_TYPE, DWRL1_DWT_MF001_INVENTORY_MOVEMENTS.E_DAT_UPDATE, DWRL1_DWT_MF001_INVENTORY_MOVEMENTS.E_COD_ADJ_REASON, DWRL1_DWT_MF001_INVENTORY_MOVEMENTS.E_NUM_TRANSACTION, DWRL1_DWT_MF001_INVENTORY_MOVEMENTS.E_COD_LOCATION, DWRL1_DWT_MF001_INVENTORY_MOVEMENTS.E_COD_PART, DWRL1_DWT_MF001_INVENTORY_MOVEMENTS.E_QTY_MOVEMENT, DWRL1_DWT_MF001_INVENTORY_MOVEMENTS.E_NUM_PUTAWAY, DWRL1_DWT_MF001_INVENTORY_MOVEMENTS.E_COD_WAREHOUSE" FromSQL = "FROM DWRL1_DWT_MF001_INVENTORY_MOVEMENTS" WhereAndOrSQL = "WHERE (((Month([E_DAT_UPDATE]))= MoisSelect) AND ((DWRL1_DWT_MF001_INVENTORY_MOVEMENTS.E_COD_PLANT_ID)=&Chr(34)&F1&Chr(34)&) AND ((DWRL1_DWT_MF001_INVENTORY_MOVEMENTS.E_COD_TRANSACTION_TYPE)=&Chr(34)&TRN&Chr(34)&) AND ((DWRL1_DWT_MF001_INVENTORY_MOVEMENTS.E_DAT_UPDATE)>#1/1/2014#) AND ((DWRL1_DWT_MF001_INVENTORY_MOVEMENTS.E_COD_ADJ_REASON) Like &Chr(34)&009&Chr(34)&) AND ((DWRL1_DWT_MF001_INVENTORY_MOVEMENTS.E_COD_LOCATION)=&Chr(34)&ZZ_CEVALEP1&Chr(34)& Or (DWRL1_DWT_MF001_INVENTORY_MOVEMENTS.E_COD_LOCATION)=&Chr(34)&ZZ_CEVALEP2&Chr(34)& Or (DWRL1_DWT_MF001_INVENTORY_MOVEMENTS.E_COD_LOCATION)=&Chr(34)&ZZ_VELEP1&Chr(34)& Or (DWRL1_DWT_MF001_INVENTORY_MOVEMENTS.E_COD_LOCATION)=&Chr(34)&ZZ_VELEP2&Chr(34)& Or (DWRL1_DWT_MF001_INVENTORY_MOVEMENTS.E_COD_LOCATION)=&Chr(34)&ZZ_PACK_20&Chr(34)& Or (DWRL1_DWT_MF001_INVENTORY_MOVEMENTS.E_COD_LOCATION)=&Chr(34)&ZZ_LEP1_LEP2&Chr(34)&));"   DataB.Execute InsertSQL & SelectSQL & FromSQL & WhereAndOrSQL DataB.Close   End Sub

---

Mais sans succès car dès le Set DataB.OpenDatabase j'ai une erreur "3343" qui stoppe l'exécution du code.

Dans la requête SQL j'ai remplacé les guillemets trouvés par les &Chr(34)&, autrement j'avais des erreurs sur la définition de la chaîne.

Est-il possible de lancer cette requête depuis VBA ?

Merci pour votre aide,

Vincent.

bonjour,

qu'elle est la version de DAO (voir liste références ) utilisée...

regarde ensuite ta requête il me semble qu'il manque des espaces entre tes clauses Insert, Select , from et where

Bonjour bbil,

La version de DAO est la 3.6.

Effectivement pour l'exécution de la requête il faudra que je pense à rajouter des espaces avant de concaténer les strings, j'avais pas vu ça, merci.

il faudrait passer sous :

Citation:

---

Microsoft Office 12.0 (14.0) Access Database Engine Object

---

voir :
http://warin.developpez.com/access/d...ge=partie_1#L1

regarde le fichier joint:

dans mon poste précédant, je t'ai mis un fichier joint qui vas te permettre de te connecter à ta base de données Access!

maintenant en ce qui concerne ta requête, tu as me semble-t-il récupérer le scripte SQL d'une requête élabore par le requêteur intégré d'Access. mais ce dernier relise un scripte pas exactement conforme à la norme SQL. il encadre les strinng par des double cote ["] mais cette formulation n'est pas bonne il faut encadrer les string par des simple cote ['].

je te suggère de reprendre le scripte Access qui lui doit fonctionner et replacer les " par des '

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19

Sql="E_COD_PART, E_QTY_MOVEMENT, E_NUM_PUTAWAY, E_COD_WAREHOUSE ) " Sql=Sql & "SELECT DISTINCT Month([E_DAT_UPDATE]) AS Mois, DWRL1_DWT_MF001_INVENTORY_MOVEMENTS.E_COD_PLANT_ID, " Sql=Sql & "DWRL1_DWT_MF001_INVENTORY_MOVEMENTS.E_COD_TRANSACTION_TYPE, DWRL1_DWT_MF001_INVENTORY_MOVEMENTS.E_DAT_UPDATE, " Sql=Sql & "DWRL1_DWT_MF001_INVENTORY_MOVEMENTS.E_COD_ADJ_REASON, DWRL1_DWT_MF001_INVENTORY_MOVEMENTS.E_NUM_TRANSACTION, " Sql=Sql & "DWRL1_DWT_MF001_INVENTORY_MOVEMENTS.E_COD_LOCATION, DWRL1_DWT_MF001_INVENTORY_MOVEMENTS.E_COD_PART, " Sql=Sql & "DWRL1_DWT_MF001_INVENTORY_MOVEMENTS.E_QTY_MOVEMENT, DWRL1_DWT_MF001_INVENTORY_MOVEMENTS.E_NUM_PUTAWAY, " Sql=Sql & "DWRL1_DWT_MF001_INVENTORY_MOVEMENTS.E_COD_WAREHOUSE " Sql=Sql & "FROM DWRL1_DWT_MF001_INVENTORY_MOVEMENTS " Sql=Sql & "WHERE (((Month([E_DAT_UPDATE]))=[INDIQUER MOIS]) " Sql=Sql & "AND ((DWRL1_DWT_MF001_INVENTORY_MOVEMENTS.E_COD_PLANT_ID)='F1') " Sql=Sql & "AND ((DWRL1_DWT_MF001_INVENTORY_MOVEMENTS.E_COD_TRANSACTION_TYPE)='TRN') " Sql=Sql & "AND ((DWRL1_DWT_MF001_INVENTORY_MOVEMENTS.E_DAT_UPDATE)>#1/1/2014#) " Sql=Sql & "AND ((DWRL1_DWT_MF001_INVENTORY_MOVEMENTS.E_COD_ADJ_REASON) Like '%009%') " Sql=Sql & "AND ((DWRL1_DWT_MF001_INVENTORY_MOVEMENTS.E_COD_LOCATION)='ZZ_CEVALEP1' " Sql=Sql & "Or (DWRL1_DWT_MF001_INVENTORY_MOVEMENTS.E_COD_LOCATION)='ZZ_CEVALEP2' " Sql=Sql & "Or (DWRL1_DWT_MF001_INVENTORY_MOVEMENTS.E_COD_LOCATION)='ZZ_VELEP1' " Sql=Sql & "Or (DWRL1_DWT_MF001_INVENTORY_MOVEMENTS.E_COD_LOCATION)='ZZ_VELEP2' " Sql=Sql & "Or (DWRL1_DWT_MF001_INVENTORY_MOVEMENTS.E_COD_LOCATION)='ZZ_PACK_20' " Sql=Sql & "Or (DWRL1_DWT_MF001_INVENTORY_MOVEMENTS.E_COD_LOCATION)='ZZ_LEP1_LEP2'));"

---

Bonjour et merci pour vos réponses!

bbil j'ai lu le cours que tu m'as envoyé, j'ai appris pas mal de petites choses mais ça ne m'a pas vraiment aidé à refaire le bout de code entièrement, cependant j'ai réussi à me connecter à la base en faisant autrement : j'ai lancé l'enregistreur de macros sur un nouveau document Excel, puis j'ai connecté la BDD directement depuis l'outil "Données => Depuis Access", de là le code récupéré fait bien mention de la référence MS ACE 12 dont tu me parlais :

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

Sub ConnectDB()   With ActiveSheet.ListObjects.Add(SourceType:=0, Source:=Array( _ "OLEDB;Provider=Microsoft.ACE.OLEDB.12.0;Password="""";User ID=Admin;Data Source=D:\users\xxxxxxx\Qualité Alex - Ex" _ , _ "tractions\PPM PACKAGERS.accdb;Mode=Share Deny Write;Extended Properties="""";Jet OLEDB:System database="""";Jet OLEDB:Registry Path=" _ , _ """"";Jet OLEDB:Database Password="""";Jet OLEDB:Engine Type=6;Jet OLEDB:Database Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;" _ , _ "Jet OLEDB:Global Bulk Transactions=1;Jet OLEDB:New Database Password="""";Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt" _ , _ " Database=False;Jet OLEDB:Don't Copy Locale on Compact=False;Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False;" _ , "Jet OLEDB:Support Complex Data=False"), Destination:=Range("$A$1")). _ QueryTable .CommandType = xlCmdTable .CommandText = Array("4-Recap LEP1") .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .BackgroundQuery = True .RefreshStyle = xlInsertDeleteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .PreserveColumnInfo = True .SourceDataFile = _ "D:\users\xxxxxx\Qualité Alex - Extractions\PPM PACKAGERS.accdb" .ListObject.DisplayName = "Tableau_PPM_PACKAGERS.accdb3" .Refresh BackgroundQuery:=False End With End Sub

---

Après je pourrai l'adapter à mes besoins sur la macro que j'ai mentionné en premier lieu.

Effectivement rdurupt j'ai repris un script SQL qui a été réalisé directement dans Access, je pensais pouvoir m'en servir tel quel mais ça me posait des problèmes avec les guillemets car ces derniers me fermaient la variable, je ne savais pas pour les simples apostrophes, merci à toi! Je vais jeter un œil sur le fichier que tu as joins et je reviendrais vers vous dès que j'aurai quelque chose de positif, afin (je l'espère) de pouvoir marquer le post comme "Résolu"! :)

Merci à vous deux encore une fois!

Bonjour,

J'ai pu faire fonctionner le code grâce à vous et je vous en remercie! Il aura simplement fallu que je modifie les informations relatives à l'accès du fichier et ça a fonctionné!

Il ne me reste qu'un petit problème à résoudre et je sèche en fait : La requête SQL fonctionne à merveille mais lors de l’exécution de celle-ci, elle fait appel à une BDD externe qui nécessite de rentrer les identifiants adéquats.

Pour résumer et clarifier : Lorsque je lance la macro fournie par rdurupt nous définissons nos variables (Type de base, chemin d'accès, User et Password) puis nous lançons la connexion grâce au module de classe ADODBRD qui va dans un premier temps sélectionner le string de connexion et me connecter à ma base de données Access locale via la fonction "OpenConnection()".

Ensuite nous exécutons la requête SQL via la fonction "Execute(Sql)".

Mon problème se situe à ce niveau car lors de l’exécution de la fonction, au niveau "Connexion.Execute Sql" il me demande de m'authentifier sur la BDD externe. Note: Si je rentre effectivement les informations, la requête SQL fait son job et ma BDD locale est bien mise à jour. Je souhaiterai justement faire en sorte que les utilisateurs n'aient pas à rentrer ces informations.

J'ai tenté de lancer la connexion à la BDD externe en même temps que la BDD locale de cette façon :

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20

Public Function OpenConnetion() 'Ouvre une connexion à la base de données. OpenConnetion = False On Error Resume Next Dim ConnecString Dim NbErr Set Connexion = CreateObject("ADODB.Connection") Connexion.Open GenereCSTRING Set Connexion2 = CreateObject("ADODB.Connection") Connexion2.Open "Driver={Microsoft ODBC for Oracle};SERVER=" & "******" & ";UID=" & "*****" & ";PWD=" & "*****" & ";" If Err = 0 Then OpenConnetion = True Connexion.CommandTimeout = 14400 Connexion2.CommandTimeout = 14400 Else MsgBox Err.Description End If Err.Clear On Error GoTo 0 End Function

---

Le problème est qu'il me demande quand même de m'authentifier avant de poursuivre, j'en ai conclu que la "Connexion2" n'était pas prise en compte lors de l'exécution de la requête.

Ma deuxième idée fut de lancer les deux connexion en même temps, de cette manière :

Code:

---

1 2	Set Connexion = CreateObject("ADODB.Connection") Connexion.Open GenereCSTRING & " Driver={Microsoft ODBC for Oracle};SERVER=" & "******" & ";UID=" & "*****" & ";PWD=" & "*****" & ";"

---

Mais là, le problème rencontré est un problème de "Pilote ISAM introuvable".

Ma dernière idée aurait été d'intégrer la "Connexion2" à la requête SQL, mais je ne suis pas sur de la façon de procéder.

Auriez-vous une solution de votre côté ? Le string de connexion à la BDD externe est la suivante :

Code:

---

"Driver={Microsoft ODBC for Oracle};SERVER=" & "******" & ";UID=" & "*****" & ";PWD=" & "*****" & ";"

---

Merci à vous,

Vincent

a ce niveau la le problème peut ce régler par Access il suffi d'autoriser l'enregistrement du mot de passe des connexion externes, vue que la base Access est protégée par un mot de passe également ça ne pose donc pas de problème!

Re-bonjour,

Ça y est tout est quasi réglé, après ce sont des problèmes de requêtes qui ne rentrent pas vraiment dans le fil de la discussion! En effet, j'ai supprimé puis refait les liaisons de BDD dans Access en cochant la case adéquate pour conserver le mot de passe.

Ceci étant : tout fonctionne normalement sous VBA désormais, c'est excellent et je vous en remercie vraiment :)

A toutes fins utiles je me suis permis de conserver les fonctions essentielles au fonctionnement de mon cas particulier (Connexion à la BDD, Exécution de la requête SQL et Fermeture de la connexion) et j'ai épuré le code au niveau du Case ... Select. Pour ceux que ça intéresserait :

Le tout fonctionne très bien sur le pack Office Pro 2010. Les références utilisées pour faire fonctionner la macro sont les suivantes :

• Visual Basic For Applications
• Microsoft Excel 14.0 Object Library
• OLE Automation
• Microsoft Office 14.0 Object Library
• Microsoft Acces 14.0 Access Library
• Microsoft ActiveX Data Objects 2.8 Library
• Microsoft Office 14.0 Access database engine Object Library

Dans un module de classe nommé ADODBRD, on met toutes les fonctions nécessaires à l'exécution (Connexion, ExecuteSQL et CloseConnexion) :

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

Private Connexion Public GenereCSTRING As String Public BASE Public Server Public User Public PassWord   Public Function OpenConnetion() 'Ouvre une connexion à la base de données. OpenConnetion = False On Error Resume Next Dim NbErr Set Connexion = CreateObject("ADODB.Connection") Connexion.Open GenereCSTRING If Err = 0 Then OpenConnetion = True Connexion.CommandTimeout = 14400 Else MsgBox Err.Description End If Err.Clear On Error GoTo 0 End Function   Public Function CloseConnection() 'Referme la connexion CloseConnection = False On Error Resume Next Connexion.Close Set Connexion = Nothing If Err = 0 Then CloseConnection = True End If Err.Clear On Error GoTo 0 End Function   'Pour les requêtes directe Public Function Execute(Sql)   Execute = False On Error Resume Next Dim NbErr Reprise: If Connexion.State = 0 Then OpenConnetion End If Debug.Print Sql   Connexion.Execute Sql Err.Clear On Error GoTo 0 End Function

---

Puis dans un module normal :

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15

Sub UpdateInvRMC() Dim Sql As String Dim cn As New ADODBRD BASE = "X:\Chemin vers la BDD Access\BDD.accdb" User = "" 'Insérer si nécessaire PassWord = "" 'Insérer si nécessaire 'Dans mon cas le GenereCSTRING était pour MS ACE 12.0, cf fichier joint par rdurupt pour un Case ... Select complet cn.GenereCSTRING = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & BASE & ";Persist Security Info=False;User ID=" & User & ";Jet OLEDB:Database Password=" & PassWord & ";"   If cn.OpenConnetion = True Then Sql = "Votre requête SQL" cn.Execute Sql cn.CloseConnection End If End Sub

---

Merci encore une fois à vous pour votre aide!

Au plaisir de vous lire.