Macro d'importation d'une table Access

Version imprimable

Bonjour,
Novice en Macro Excel, j'essaie de faire une macro afin de récupérer une table Access depuis Excel.

Sachant que la macro devra aller chercher le nom du fichier Access, et le nom de la table, dans deux cellules préalablement renseignées dans le fichier Excel.
L'emplacement du fichier Access est connu et ne change pas. idem pour la position du fichier Excel qui porte la macro.

J'ai bien réussi, par enregistrement, à créer le code ci-dessous, mais je n'arrive pas à m'approprier le code enregistrer automatiquement, et à paramétrer la possibilité de choisir le fichier Access et de la table que je veux importer.
Dans l'exemple ci-dessous le nom de la table "TRAVAUX_DEC" et le nom du fichier "225-360-PG3.mdb" doivent pouvoir etre changer via les deux celulles rempli sous Excel.
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 ActiveWorkbook.Queries.Add Name:="TRAVAUX_DEC", Formula:= _ "let" & Chr(13) & "" & Chr(10) & " Source = Access.Database(File.Contents(""C:\DATA\225-360-PG3.mdb""), [CreateNavigationProperties=true])," & Chr(13) & "" & Chr(10) & " _TRAVAUX_DEC = Source{[Schema="""",Item=""TRAVAUX_DEC""]}[Data]" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & " _TRAVAUX_DEC" ActiveWorkbook.Worksheets.Add With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _ "OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=TRAVAUX_DEC;Extended Properties=""""" _ , Destination:=Range("$A$1")).QueryTable .CommandType = xlCmdSql .CommandText = Array("SELECT * FROM [TRAVAUX_DEC]") .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .BackgroundQuery = True .RefreshStyle = xlInsertDeleteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .PreserveColumnInfo = True .ListObject.DisplayName = "TRAVAUX_DEC" .Refresh BackgroundQuery:=False End With
Est-ce qu’il est possible de modifier ce code enregistré automatiquement, et je n'ai pas encore trouvé comment faire, ou est ce que je dois trouver une autre solution ?

Merci

Hello,

l'enregistreur de macro produit un code difficilement lisible... j'ai essayé d'adapter et de le clarifier un peu, mais c'est sans garantie

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
    Dim Nom_Table As String
    Dim Nom_Fichier As String
 
    ' *** à adapter ***
    Nom_Fichier = Workbooks("nom_classeur").Worksheets("nom_feuille").Range("A1")
    Nom_Table = Workbooks("nom_classeur").Worksheets("nom_feuille").Range("A2")
    ' *** à adapter ***
 
    ActiveWorkbook.Queries.Add _
        Name:=Nom_Table, _
        Formula:= _
            "let" & Chr(13) & "" & Chr(10) & _
            "Source = Access.Database(File.Contents(""C:\DATA\" & Nom_Fichier & ".mdb""), " & _
            "[CreateNavigationProperties=true])," & Chr(13) & "" & Chr(10) & _
            "_TRAVAUX_DEC = Source{[Schema="""",Item=" & Nom_Table & "]}[Data]" & Chr(13) & "" & Chr(10) & _
            "in" & Chr(13) & "" & Chr(10) & _
            "_TRAVAUX_DEC"
 
    ActiveWorkbook.Worksheets.Add
 
    With ActiveSheet.ListObjects.Add(SourceType:=0, _
        Source:="OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=" & Nom_Table & ";Extended Properties=""""", _
        Destination:=Range("$A$1")).QueryTable
        .CommandType = xlCmdSql
        .CommandText = Array("SELECT * FROM [" & Nom_Table & "]")
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .ListObject.DisplayName = Nom_Table
        .Refresh BackgroundQuery:=False
    End With

05/11/2024, 17h07
Philippe Tulliez

Bonjour,
Dans ce billet, VBA Excel – Fonction qui renvoie une liste de données résultant d’une requête SQL dans Access, je propose le code d'une fonction générique qui renvoie le résultat d'une requête SQL.
Cependant je privilégie maintenant Power Query, intégré à Excel depuis la version 2016, pour importer des tables ou des requêtes depuis Access.
05/11/2024, 17h09
Nain porte koi

harf, j'ai encore oublié Power Query :oops:

Bonjour,
Merci pour vos retours.
Je ne maitrise pas suffisamment les macros pour comprendre et m'approprier le code fourni par Philippe Tulliez.

Je pensais avoir utilisé Power Query dans ma macro. J’avoue etre un peu dépassé.

Nain porte koi, ton code crée un message d'erreur "Erreur :1004 - Référence cyclique".
et je constate qu'il est encore fait référence au nom de la table "TRAVAUX_DEC" et non pas à la variable "Nom_Table" dans ton code.
J'ai facilement remplacé le second, mais je n'arrive pas à remplacer le premier. Sans s'avoir si c'est ça qui crée la référence cyclique.
Code:

1 2 3 4 5 6 7 Formula:= _ "let" & Chr(13) & "" & Chr(10) & _ "Source = Access.Database(File.Contents(""C:\DATA\" & Nom_Fichier & ".mdb""), " & _ "[CreateNavigationProperties=true])," & Chr(13) & "" & Chr(10) & _ "_TRAVAUX_DEC = Source{[Schema="""",Item=" & Nom_Table & "]}[Data]" & Chr(13) & "" & Chr(10) & _ "in" & Chr(13) & "" & Chr(10) & _ "_" & Nom_Table
Merci d'avance pour votre aide.

06/11/2024, 14h24
mapeh
Bonjour,
Sans filets..
Tiré de l'aide µSoft sous ce lien :

Citation:

Une requête de langage de formule M Power Query est composée d’étapes d’expression de formule qui créent une requête hybride. Une expression de formule peut être évaluée (calculée) et produire une valeur. L’expression let encapsule un ensemble de valeurs à calculer, auxquelles des noms sont affectés, puis qui sont utilisées dans une expression ultérieure qui suit l’instruction in. Par exemple, une expression let peut contenir une variable Source qui est égale à la valeur de Text.Proper et qui génère une valeur texte dans la casse appropriée.

Donc, l'expression qui suit l'instruction "in" doit être l'étape précédente.
Dans le code fourni, il faut remplacer Nom_Table :
Code:

1 2 "in" & Chr(13) & "" & Chr(10) & _ "_" & Nom_Table
par la dernière étape :
Code:

1 2 "in" & Chr(13) & "" & Chr(10) & _ "_TRAVAUX_DEC"
Nota, on peut très bien renommer la dernière étape "_TRAVAUX_DEC" par n'importe quel terme, qui sera à remplir également après le "in"

Bonne journée

Bonjour mapeh,
et donc pourquoi est ce que j'ai l'erreur "Erreur :1004 - Référence cyclique" ?

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
 
Sub test()
 
    Dim Nom_Fichier As String
    Dim Nom_Table As String
 
    ' *** à adapter ***
    Nom_Fichier = Range("C2")
    Nom_Table = Range("C18")
    ' *** à adapter ***
 
    ActiveWorkbook.Queries.Add _
        Name:=Nom_Table, _
        Formula:= _
            "let" & Chr(13) & "" & Chr(10) & _
            "Source = Access.Database(File.Contents(""C:\Andalis\BUDGETS\DATA\" & Nom_Fichier & ".mdb""), " & _
            "[CreateNavigationProperties=true])," & Chr(13) & "" & Chr(10) & _
            "_TRAVAUX_DEC = Source{[Schema="""",Item=" & Nom_Table & "]}[Data]" & Chr(13) & "" & Chr(10) & _
            "in" & Chr(13) & "" & Chr(10) & _
            "_TRAVAUX_DEC"
 
    ActiveWorkbook.Worksheets.Add
 
    With ActiveSheet.ListObjects.Add(SourceType:=0, _
        Source:="OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=" & Nom_Table & ";Extended Properties=""""", _
        Destination:=Range("$A$1")).QueryTable
        .CommandType = xlCmdSql
        .CommandText = Array("SELECT * FROM [" & Nom_Table & "]")
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .ListObject.DisplayName = Nom_Table
        .Refresh BackgroundQuery:=False
    End With
End Sub

Merci

06/11/2024, 15h45
mapeh

Re-,
Chez moi, avec ton code, j'ai une autre erreur... (Erreur 1004, erreur définie par l'application....)

En modifiant le code Item comme ceci, l'importation se fait bien

Code:

[Schema="""",Item=""" & Nom_Table & """]

Note les """ & Nom_Table & """ (3 guillemets de part en d'autre)
Peut-être?

3 pièce(s) jointe(s)

Merci à tous j'ai réussi à corriger le probléme avec votre aide.

La requête envoyée à Power_Query n'était pas correctement écrite :
Pièce jointe 661409

J'ai dû mettre des guillemets dans une cellule pour réussir à les appeler dans ma variable.
Il y a surement une façon plus élégante, mais je suis satisfait d'avoir réussi.

Ci-dessous le code qui fonctionne.

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()
 
    Dim Nom_Fichier As String
    Dim Nom_Table As String
 
    ' *** à adapter ***
    Nom_Fichier = Range("C2")
    Nom_Table = Range("C18")
    Table = Range("H2") & Range("C18") & Range("H2")
    ' *** à adapter ***
 
    ActiveWorkbook.Queries.Add _
        Name:=Nom_Table, _
        Formula:= _
            "let" & Chr(13) & "" & Chr(10) & _
            "Source = Access.Database(File.Contents(""C:\DATA\" & Nom_Fichier & ".mdb""), " & _
            "[CreateNavigationProperties=true])," & Chr(13) & "" & Chr(10) & _
            "_TABLE = Source{[Schema="""",Item=" & Table & "]}[Data]" & Chr(13) & "" & Chr(10) & _
            "in" & Chr(13) & "" & Chr(10) & _
            "_TABLE"
 
 
    ActiveWorkbook.Worksheets.Add
 
    With ActiveSheet.ListObjects.Add(SourceType:=0, _
        Source:="OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=" & Nom_Table & ";Extended Properties=""""", _
        Destination:=Range("$A$1")).QueryTable
        .CommandType = xlCmdSql
        .CommandText = Array("SELECT * FROM [" & Nom_Table & "]")
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .ListObject.DisplayName = Nom_Table
        .Refresh BackgroundQuery:=False
    End With
 
End Sub

Merci à tous je clos le sujet.

06/11/2024, 15h50
Seb_6

Citation:

Envoyé par mapeh

Re-,
Chez moi, avec ton code, j'ai une autre erreur... (Erreur 1004, erreur définie par l'application....)

En modifiant le code Item comme ceci, l'importation se fait bien

Code:

[Schema="""",Item=""" & Nom_Table & """]

Note les """ & Nom_Table & """ (3 guillemets de part en d'autre)
Peut-être?

RE
J'ai essayé avec les 3 guillemets mais cela ne fonctionnait pas.
Merci
06/11/2024, 16h28
Philippe Tulliez

Bonjour,
Pourquoi passer par une procédure VBA pour utiliser Power Query ?
07/11/2024, 13h59
Seb_6

Bonjour,
Ma requête initiale est l'importation d'une Table d'une base de données Access dans Excel.
Je ne serais pas le seul utilisateur du fichier, je devais donc passer par une macro pour que n'importe quel utilisateur puisse faire l’importation.

Bonjour,

L'avantage de PowerQuery c'est de pouvoir actualiser le résultat
La question est donc : faut-il pouvoir actualiser ?
Peut-être même peut-on fournir le fichier avec la requête PowerQuery en place et juste demander d'actualiser

Sinon, si c'est juste le chargement d'une table ou requête Access, qu'on pourra potentiellement relancer d'ailleurs, je n'utiliserais pas forcément PowerQuery, mais ça peut se peut discuter

un exemple (B1 contient le dossier d'emplacement de la base Access, B2 contient le nom de la base Access avec l'extension, remplacer "Liste" par le nom de la table ou requête, adapter le code SQL dans LitDonnees)

Les résultats s'affichent dans une feuille vide nommée Result

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
Dim Conn As Object
 
Sub Lance()
    LitDonnees "Liste"
End Sub
 
Sub OuvreConnexion()
Dim ChainConn As String, Dossier As String, Fichier As String
    Dossier = Range("B1").Value
    Fichier = Range("B2").Value
    ChainConn = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & _
        Dossier & Fichier & ";Persist Security Info=False;"
    Set Conn = CreateObject("ADODB.Connection")
    Conn.Open ChainConn
    If Conn.State = 0 Then MsgBox "Erreur connexion"
End Sub
 
Sub FermeConnexion()
    If Not Conn Is Nothing Then
        If Conn.State = 1 Then
            Conn.Close
        End If
    End If
    Set Conn = Nothing
End Sub
 
Sub LitDonnees(NomTable As String)
Dim Rs As Object, i As Long
    With ThisWorkbook.Sheets("Result").Range("A1")
        .CurrentRegion.ClearContents
        OuvreConnexion
        Set Rs = Conn.Execute("Select * from " & NomTable)
        'Set Rs = Conn.Execute("Select * from Liste inner join Dept on Liste.Dept=Dept.Depart")
        'Set Rs = Conn.Execute("Select count(*) as Nombre from Liste")
 
        For i = 0 To Rs.Fields.Count - 1
            .Offset(0, i).Value = Rs.Fields(i).Name
        Next
        .Offset(1, 0).CopyFromRecordset Rs
    End With
    Rs.Close
    Set Rs = Nothing
    FermeConnexion
End Sub

08/11/2024, 10h33
78chris

Bonjour à tous

Une requête est actualisable par n'importe qui : nul besoin de coder d'autant que l'actualisation peut être faite automatiquement à l'ouverture d'Excel.

Par ailleurs PowerQuery permet même d'effectuer une requête avec paramètres afin que ce soit le moteur du SGBD (Access ou autre) qui calcule et non Excel.
08/11/2024, 10h42
tototiti2008

Bonjour chris :),

oui, c'est ce que sous-entendait ma phrase

Citation:

Peut-être même peut-on fournir le fichier avec la requête PowerQuery en place et juste demander d'actualiser

Dans ce cas pas besoin de macro (ou juste une macro qui actualise la requête, à la rigueur)