Fonction qui renvoie une table contenant résultat d'une requête SQL sur une base de données Access
Bonjour,
Je vous propose une petite procédure qui importe le résultat d'une requête faite sur une base de données Access dans une feuille Excel.
Cette requête est exécutée par une fonction nommée QueryAccess qui renvoie une table contenant le résultat d'une requête faite sur une base de données Access.
Référencement
Pour faire fonctionner la fonction, il est nécessaire de référencer Microsoft DAO 3.6 ObjectLibrary. Dans l'éditeur VBA Outils/Références...
Base de données
La base de données utilisée est Comptoir.mdb livrée avec Access.
Les variables servant au test
Query - Contient la requête SQL.
db - Nom du fichier contenant la base de données précédé du chemin complet
En production, ces deux variables sont placées dans une cellule mais pour une meilleure compréhension du code, j'ai utilisé des constantes.
shtExport - CodeName de la feuille Excel où a lieu l'exportation du résultat de la requête sur la base de données Access
Les arguments de la fonction
dbFullName de type String, contient le chemin complet + le nom de la base de données.
SqlQuery de type String, contient la requête SQL.
En-tête de module
Code:
1
2
3
| Option Explicit
Const Query As String = "SELECT Clients.Société, Clients.Fonction, Clients.Ville, Clients.Région FROM Clients;"
Const db As String = "Z:\Test\_mso Vba - Access\DataBase\Comptoir.mdb" |
La fonction QueryAccess
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
| Function QueryAccess(dbFullName As String, SqlQuery As String)
' Nécessite de référencer Microsoft DAO x.x ObjectLibrary
' Arguments
' dbFullName ' Chemin + nom du fichier
' SqlQuery ' Chaîne de caractère contenant la requête SQL
' Variables - Déclaration et affectation des valeurs
Dim db As DAO.Database, Rs As DAO.Recordset
Dim myTable(), count As Long, Elem As Integer
Set db = Workspaces(0).OpenDatabase(dbFullName, ReadOnly:=True)
Set Rs = db.OpenRecordset(SqlQuery)
' Lecture des enregistrements de la requête
While Not Rs.EOF
ReDim Preserve myTable(Rs.Fields.count, count)
For Elem = 0 To Rs.Fields.count - 1
If count = 0 Then
myTable(Elem, count) = Rs(Elem).SourceField ' Etiquettes de colonnes
Else
myTable(Elem, count) = IIf(IsNull(Rs(Elem)), "", Rs(Elem))
End If
Next Elem
count = count + 1: Rs.MoveNext
Wend
QueryAccess = Application.WorksheetFunction.Transpose(myTable)
Rs.Close: db.Close: Set Rs = Nothing
End Function |
La procédure de test
Code:
1
2
3
4
5
6
7
8
9
10
11
| Sub TestQuery()
Dim myTable(), dbExport As Range
' Dim db As String, Query As String
' db = shtParam.Range("pDataBase")
' Query = shtSql.Range("B3")
myTable = QueryAccess(db, Query)
With shtExport
Set dbExport = .Range("A1", .Cells(UBound(myTable, 1), UBound(myTable, 2)))
End With
dbExport = myTable
End Sub |
