Lancer une requête de création de table à partir d'une feuille Excel

Version imprimable

Bonjour,
Avec l'aide grandiose de rdurupt et de dysorthographie, j'ai crée une code vba qui me permet d 'éxécuter une requete paramatrée à partir d'une feuille Excel. (code ci dessous macro1).
Le soucis, c'est que je souhaiterais faire la même chose avec avec une requete création de table paramétrée ( avec comme parametre date debut et fin).
Lorsque je lance le code ci dessous avec ma requete création de table paramétrée, j'ai un message d'erreur qui s'affiche à la ligne 41

Code:

Set rs = Cm.Execute 'on recupere le résultat de la requête

le message d'erreur est le suivant:

Citation:

Une requête action ne peut etre utilisée comme contenu

Merci d'avance pour votre aide

Sub Macro1()

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
Dim sql As String
Dim GenereCSTRING As String
Dim Debut As Object
Dim Fin As Object
Dim Cm As Object 'Pour utiliser une requête parametrés il faut utiliser l'oblet Command!
Dim cn As Object 'Pour ce connecter à un base de données Access il faut utiliser l'objet Connection!
Dim rs As Object
 
Dim i As Integer
 
 
 
sql = "SELECT  * FROM requete1" ' je détermine une requête sql qui pointe sur ta requête Acces."
 
 
Set cn = CreateObject("ADODB.Connection")
Set Cm = CreateObject("Adodb.Command")
 
 GenereCSTRING = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=P:\chemin\BaseDonnee.accdb;;Persist Security Info=False" 'Je defini un chêne de texte qui contient les information de ma connection.
 cn.Open GenereCSTRING 'J'ouvre ma connection.
 
 
Cm.CommandText = sql 'je passe ma requête à mon objet command
Cm.ActiveConnection = cn 'j'affecte ma connection à ma commande
 
Const adDate = 7 'defini le type de parametre
 
 
'c'est avec l'objet Parameter que je vais renseigner les parmetres de ma requête Access.
'Cellule où est stokcé la date cdate(format(ThisWorkbook.Sheets("Feuil1").range("B1").value,"yyyy-mm-dd hh:mm"))
 
Set Debut = CreateObject("ADODB.Parameter")
Debut.Name = "debut": Debut.Type = adDate: Debut.Value = CDate(Format(ThisWorkbook.Sheets("Feuil1").Range("B1").Value, "yyyy-mm-dd hh:mm")): Cm.Parameters.Append Debut
 
Set Fin = CreateObject("ADODB.Parameter") 'c'est avec l'objet Parameter que je vais reseigner les parmetres de ma requête Access.
Fin.Name = "Fin": Fin.Type = adDate: Fin.Value = CDate(Format(ThisWorkbook.Sheets("Feuil1").Range("B2").Value, "yyyy-mm-dd hh:mm")): Cm.Parameters.Append Fin
 
 
Set rs = Cm.Execute 'on recupere le résultat de la requête.
 
With ThisWorkbook.Sheets("Feuil2")
 
     For i = 0 To rs.Fields.Count - 1 'On place le nom des champs sur la ligne 4 de ma feuille Excel
               .Range("A1").Offset(0, i) = rs(i).Name 'ligne desactivé seulement aprés avoir été validé la 1ere fois
     Next
 
        .Range("A2").CopyFromRecordset rs 'la on copie le résultat de la requête!
 
End With
End Sub

28/03/2017, 16h39
Invité

Bonjour,
rdurupt = dysorthographie (Le roi est mort vive le le roi!)

Citation:

je souhaiterais faire la même chose avec avec une requete création de table paramétrée

tu veux créer une table dans Access ou créer un nouvel onglet dans Excel?
29/03/2017, 11h58
facteur

mdr...
Bonjour dysorthographie,
pour être complet,je souhaite extraire une donnée qui est issue d'une table qui elle même est issue d'une requête création de table.
Donc je souhaite créer une table dans Access; Mais cette table serait créee à partir d'Excel comme le faite ton code vba avec une requête simple...:)

Bonjour,

Code:

sql = "SELECT  *  INTO [TOTO]FROM requete1" ' je détermine une requête sql qui pointe sur ta requête Access et on lui donne la table TOTO comme cible !."

Code:

1
2
3
On Error Resume Next
    cn.Execute "Drop Table [TOTO]" 'on supprime la table TOTO qui à priori n'existe pas encore d'ou le on error! 
 On Error GoTo 0

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
ub test()Dim sql As String
Dim GenereCSTRING As String
Dim Debut As Object
Dim Fin As Object
Dim Cm As Object 'Pour utiliser une requête parametrés il faut utiliser l'oblet Command!
Dim cn As Object 'Pour ce connecter à un base de données Access il faut utiliser l'objet Connection!
Dim rs As Object
 
Dim i As Integer
 
 
 
sql = "SELECT  *  INTO [TOTO] FROM requete1" ' je détermine une requête sql qui pointe sur ta requête Acces."
 
 
Set cn = CreateObject("ADODB.Connection")
Set Cm = CreateObject("Adodb.Command")
 
 GenereCSTRING = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=P:\chemin\BaseDonnee.accdb;;Persist Security Info=False" 'Je defini un chêne de texte qui contient les information de ma connection.
 
 
 cn.Open GenereCSTRING 'J'ouvre ma connection.
  On Error Resume Next
    cn.Execute "Drop Table [TOTO]"
 On Error GoTo 0
 
Cm.CommandText = sql 'je passe ma requête à mon objet command
Cm.ActiveConnection = cn 'j'affecte ma connection à ma commande
 
Const adDate = 7 'defini le type de parametre
 
 
'c'est avec l'objet Parameter que je vais renseigner les parmetres de ma requête Access.
'Cellule où est stokcé la date cdate(format(ThisWorkbook.Sheets("Feuil1").range("B1").value,"yyyy-mm-dd hh:mm"))
 
Set Debut = CreateObject("ADODB.Parameter")
Debut.Name = "debut": Debut.Type = adDate: Debut.Value = CDate(Format(ThisWorkbook.Sheets("Feuil1").Range("B1").Value, "yyyy-mm-dd hh:mm")): Cm.Parameters.Append Debut
 
Set Fin = CreateObject("ADODB.Parameter") 'c'est avec l'objet Parameter que je vais reseigner les parmetres de ma requête Access.
Fin.Name = "Fin": Fin.Type = adDate: Fin.Value = CDate(Format(ThisWorkbook.Sheets("Feuil1").Range("B2").Value, "yyyy-mm-dd hh:mm")): Cm.Parameters.Append Fin
 
 Cm.Execute 'on Exécute la requête de création de table!.
'Set rs = Cm.Execute 'on recupere le résultat de la requête.
'
'With ThisWorkbook.Sheets("Feuil2")
'
'     For i = 0 To rs.Fields.Count - 1 'On place le nom des champs sur la ligne 4 de ma feuille Excel
'               .Range("A1").Offset(0, i) = rs(i).Name 'ligne desactivé seulement aprés avoir été validé la 1ere fois
'     Next
'
'        .Range("A2").CopyFromRecordset rs 'la on copie le résultat de la requête!
'
'End With
End Sub

30/03/2017, 09h48
facteur

Merci pour cette rapide réponse dysorthographie.
J'ai donc refaire mon code Vba avec tes modifications et j'ai une erreur sur la ligne 42

Code:

Cm.Execute 'on Exécute la requête de création de table!.

le message d'erreur est le suivant:
erreur d'execution

Citation:

Instruction SQL non valide DELETE, INSERT, PROCEDURE, SELECT ou UPDATE attendus

Bonjour,
Voilà ce qui fonctionne chez moi!

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
Enum ConstAdo 'énumerateur defini le type de parametre
    adSmallInt = 2
    adBigInt = 20
    adBinary = 128
    adBoolean = 11 '  YesNo
    adChar = 129
    adCurrency = 6 '   Currency
    adDate = 7  ' Date
    adDBTimeStamp = 135 ' DateTime (Access 97 (ODBC))
    adDecimal = 14
    adDouble = 5  '   Double
    adGUID = 72  'ReplicationID (Access 97 (OLEDB)), (Access 2000 (OLEDB))
    adIDispatch = 9
    adInteger = 3  '  AutoNumber
    adLongVarBinary = 205 ' OLEObject
    adLongVarChar = 201 ' Memo (Access 97)
    adLongVarWChar = 203 'Memo (Access 2000 (OLEDB))
    adNumeric = 131 ' Decimal (Access 2000 (OLEDB))
    adSingle = 4   '  Single
    adUnsignedTinyInt = 17  ' Byte
    adVarBinary = 204 'ReplicationID (Access 97)
    adVarChar = 200 ' Text (Access 97)
    adVariant = 12
    adVarWChar = 202 ' Text (Access 2000 (OLEDB))
    adWChar = 130
End Enum
Sub test()
Dim sql As String
Dim GenereCSTRING As String
Dim Debut As Object
Dim Fin As Object
Dim Cm As Object 'Pour utiliser une requête parametrés il faut utiliser l'oblet Command!
Dim cn As Object 'Pour ce connecter à un base de données Access il faut utiliser l'objet Connection!
sql = "SELECT Requête2.* INTO titi FROM Requête2;" ' je détermine une requête sql qui pointe sur ta requête Acces."
Set cn = CreateObject("ADODB.Connection")
Set Cm = CreateObject("Adodb.Command")
  GenereCSTRING = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=C:\Users\rdurupt\Documents\Base de données1.accdb;;Persist Security Info=False" 'Je defini un chêne de texte qui contient les information de ma connection.
  cn.Open GenereCSTRING 'J'ouvre ma connection.
  On Error Resume Next
    cn.Execute "Drop Table [titi]"
 On Error GoTo 0
 Cm.CommandText = sql 'je passe ma requête à mon objet command
Cm.ActiveConnection = cn 'j'affecte ma connection à ma commande
'c'est avec l'objet Parameter que je vais renseigner les parmetres de ma requête Access.
Set ID = CreateObject("ADODB.Parameter")
ID.Name = "ID": ID.Type = adVarChar: ID.Value = "rr": ID.Size = 255: Cm.Parameters.Append ID
Cm.Execute 'on Exécute la requête de création de table!.
End Sub

30/03/2017, 12h19
patricktoulon

re

salut robert si tu vois robert tu le salut de ma part :ptdr:
30/03/2017, 12h38
Invité

je le vois tous les matin dans ma glace! on habite ensemble maintenant! il te salut bien!

quand on a peur de la solitude la schizophrénie ça aide!

mdr,
dysorthographie on t'aime bien je crois ... lol

J'ai inséré la modification que tu m'as faite au niveau de la ligne 34

Code:

sql = "SELECT Requête2.* INTO titi FROM Requête2;" ' je détermine une requête sql qui pointe sur ta requête Acces."

mais maintenant, j'ai le message d'erreur suivant qui s'affiche :

Citation:

la table titi existe déjà

C'est une erreur qui revient souvent lorsque l'on essaie d'automatiser la création de table en vba.
Sur ma base de donnée ou est insérée ma requête création de table, j'ai une fonction qui évite cette erreur :

Question1) dans ton code, comment éviter cette erreur
Question 2) crois tu que l'on peut insérer le code ci dessous dans ton code vba ..:roll:

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
Option Compare Database
 
Public Function ExisteTable(titi As String) As Boolean   ' Fonction de test existance table
'Pour fonctionner ce code nécessite la référence
'   - Microsoft DAO X Object Library
On Error GoTo Err
    Dim oDb As DAO.Database
    Dim oQdf  As DAO.TableDef
    'Accède à la base de données courante
    Set oDb = CurrentDb
    Set oQdf = oDb.TableDefs(titi)
    'Retourne Vrai
    ExisteTable = True
fin:
    'Libère les objets
    Set oDb = Nothing
    Set oQdf = Nothing
    Exit Function
Err:
    'Remonte toutes les erreurs différents de l'erreur 3265
    '(la requête n'existe pas)
    If Err.Number <> 3265 Then
        Err.Raise Err.Number, Err.Source, Err.Description
    End If
    Resume fin
End Function
 
'---------------------------------------------------------------------------------------
'Fonction de suppression d'une table
'---------------------------------------------------------------------------------------
 
Public Sub Delete_Tbl(ByVal titi As String)
On Error Resume Next
    Dim oDb As DAO.Database
 
    Set oDb = CurrentDb
    oDb.TableDefs.Delete titi
 
End Sub
Public Sub LanceRequeteCreation(Requête2 As String)    ' lance les requetes creation de table
  Dim ReqFind As DAO.QueryDef
     Set ReqFind = CurrentDb.QueryDefs(Requête2)   ' lancement requete creation table
     ReqFind.Execute          ' execution requete
     Set ReqFind = Nothing    ' fermeture
End Sub
 
Public Sub MiseAjour()
 
 
    Dim stDocName As String
    Dim stLinkCriteria As String
    If ExisteTable("titi") Then   ' Si la table recherche existe
        Call Delete_Tbl("titi")   ' on la supprime
    End If
    LanceRequeteCreation ("Requête2")   ' lancement requete creation de la nouvelle table
 
End Sub

Bonjour,
dans ton code on est dans Access plus dans Excel?*

Code:

1
2
Option Compare Database
Dim oDb As DAO.Database

Code:

1
2
3
4
5
Public Sub Delete_Tbl(ByVal titi As String)
On Error Resume Next
 CurrentDb.Execute "Drop Table [" & titi & "];"
On Error GoTo 0
End Sub

31/03/2017, 13h26
facteur

Et ...que dois je faire de ce code, dois je l'insérer dans ton code ? :roll:

il est extrait de ton code!

Code:

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

'---------------------------------------------------------------------------------------
'Fonction de suppression d'une table
'---------------------------------------------------------------------------------------
 
Public Sub Delete_Tbl(ByVal titi As String)
On Error Resume Next
    Dim oDb As DAO.Database
 
    Set oDb = CurrentDb
    oDb.TableDefs.Delete titi
  EndSub

je l'avais bien compris mais j'ai un soucis, je n'arrive pas a appeler ce bout code dans le module sub (test).

J'ai essayé ceci
dans ta procédure sub test (), aprés la ligne 38

Code:

c.Open GenereCSTRING 'J'ouvre ma connection

Je créer un Call qui appelle la procédure MiseAjour

Code:

1
2
3
4
5
Public Sub MiseAjour()
 
 Call Delete_Tbl("titi")   ' on la supprime
 
End Sub

Code:

1
2
3
4
5
Public Sub Delete_Tbl(ByVal titi As String)
On Error Resume Next
 CurrentDb.Execute "Drop Table [" & titi & "];"
On Error GoTo 0
End Sub

mais J'ai toujours le message d'erreur ("la table titi existe déjà") qui s'affiche à la ligne 47

Voici le code en entier

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
Sub test()
 
Application.ScreenUpdating = False
 
 
Dim sql As String
Dim GenereCSTRING As String
Dim Debut As Object
Dim Fin As Object
Dim Cm As Object 'Pour utiliser une requête parametrés il faut utiliser l'oblet Command!
Dim cn As Object 'Pour ce connecter à un base de données Access il faut utiliser l'objet Connection!
 
Dim i As Integer
 
 
sql = "SELECT Requête2.* INTO titi FROM Requête2;" ' je détermine une requête sql qui pointe sur ta requête Acces."
  '"SELECT Requête2.* INTO titi FROM Requête2;"
 
Set cn = CreateObject("ADODB.Connection")
Set Cm = CreateObject("Adodb.Command")
 
 GenereCSTRING = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=chemin\base1.accdb;;Persist Security Info=False" 'Je defini un chêne de texte qui contient les information de ma connection.
 cn.Open GenereCSTRING 'J'ouvre ma connection.
 
Call MiseAjour
 
  On Error Resume Next
    'cn.Execute "INTO titi FROM Requête2"
    CurrentDb.Execute "Drop Table [" & titi & "];"
 On Error GoTo 0
 
Cm.CommandText = sql 'je passe ma requête à mon objet command
Cm.ActiveConnection = cn 'j'affecte ma connection à ma commande
 
 
Const adDate = 7 'defini le type de parametre
Const adVarChar = 200
 
Set Debut = CreateObject("ADODB.Parameter")
Debut.Name = "debut": Debut.Type = adDate: Debut.Value = CDate(Format(ThisWorkbook.Sheets("Feuil1").Range("B1").Value, "yyyy-mm-dd hh:mm")): Cm.Parameters.Append Debut
 
Set Fin = CreateObject("ADODB.Parameter") 'c'est avec l'objet Parameter que je vais reseigner les parmetres de ma requête Access.
Fin.Name = "Fin": Fin.Type = adDate: Fin.Value = CDate(Format(ThisWorkbook.Sheets("feuil1").Range("B2").Value, "yyyy-mm-dd hh:mm")): Cm.Parameters.Append Fin
 
 
 
 Cm.Execute

tu développe de la main gauche un code sous Access et de la main droite un code sous Excel! et de temps en temps tu passe le tout au shaker!

CurrentDb c'est DAO Access

Cn.execute c'est ADO ADODB.

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
Sub test() 
Application.ScreenUpdating = False
 
 
Dim sql As String
Dim GenereCSTRING As String
Dim Debut As Object
Dim Fin As Object
Dim Cm As Object 'Pour utiliser une requête parametrés il faut utiliser l'oblet Command!
Dim cn As Object 'Pour ce connecter à un base de données Access il faut utiliser l'objet Connection!
 
Dim i As Integer
 
 
sql = "SELECT Requête2.* INTO titi FROM Requête2;" ' je détermine une requête sql qui pointe sur ta requête Acces."
  '"SELECT Requête2.* INTO titi FROM Requête2;"
 
Set cn = CreateObject("ADODB.Connection")
Set Cm = CreateObject("Adodb.Command")
 
 GenereCSTRING = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=chemin\base1.accdb;;Persist Security Info=False" 'Je defini un chêne de texte qui contient les information de ma connection.
 cn.Open GenereCSTRING 'J'ouvre ma connection.
 
Call MiseAjour
 
  On Error Resume Next
    'cn.Execute "INTO titi FROM Requête2"
    cn.Execute "Drop Table [titi];"
 On Error GoTo 0
 
Cm.CommandText = sql 'je passe ma requête à mon objet command
Cm.ActiveConnection = cn 'j'affecte ma connection à ma commande
 
 
Const adDate = 7 'defini le type de parametre
Const adVarChar = 200
 
Set Debut = CreateObject("ADODB.Parameter")
Debut.Name = "debut": Debut.Type = adDate: Debut.Value = CDate(Format(ThisWorkbook.Sheets("Feuil1").Range("B1").Value, "yyyy-mm-dd hh:mm")): Cm.Parameters.Append Debut
 
Set Fin = CreateObject("ADODB.Parameter") 'c'est avec l'objet Parameter que je vais reseigner les parmetres de ma requête Access.
Fin.Name = "Fin": Fin.Type = adDate: Fin.Value = CDate(Format(ThisWorkbook.Sheets("feuil1").Range("B2").Value, "yyyy-mm-dd hh:mm")): Cm.Parameters.Append Fin
 
 
 
 Cm.Execute