Excel et Access : Requêtes en VBA

**Pou007a** · 17/07/2014, 13h21

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 :

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

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 :

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

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.

**SfJ5Rpw8** · 17/07/2014, 13h38

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

**Pou007a** · 17/07/2014, 14h14

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.

**SfJ5Rpw8** · 17/07/2014, 15h55

il faudrait passer sous :

Microsoft Office 12.0 (14.0) Access Database Engine Object

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

Invité · 18/07/2014, 16h13

regarde le fichier joint:

Invité · 19/07/2014, 22h47

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 :

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
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'));"

**Pou007a** · 21/07/2014, 09h24

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 :

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

**Pou007a** · 22/07/2014, 10h26

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 :

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

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

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 :

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

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

Merci à vous,

Vincent

Invité · 22/07/2014, 11h05

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!

**Pou007a** · 22/07/2014, 13h27

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 :

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

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

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.

Excel et Access : Requêtes en VBA [XL-2010]

Macros et VBA Excel

Discussions similaires

Partager

Partager