Sous Excel, il est parfois utile d'interagir avec des fichiers Access, par exemple si vous disposez d'une version d'Office sans Access mais que vous avez besoin d'expoiter des données au format .mdb ou .accdb
La solution passe par ADO (ActiveX Data Objects) et des requêtes Sql (cf. http://sql.sh/).
A noter, le Vba n'accepte pas tout le langage Sql standard, mais pour l'essentiel on y arrive.
La méthode se base sur une fonction "passe-partout" qui établit la connection avec le fichier externe et qui exécute une requête Sql quelconque (en lecture ou écriture). La fonction renvoie un entier long correspondant soit à -1 si problème, soit 0 pour des requêtes INSERT ou DELETE qui ont abouti, soit au nombre d'enregistrements lus pour des requêtes SELECT. Dans ce dernier cas les enregistrements sont stockés dans la variable tableau "Rcd".
Voici son code à mettre dans un module quelconque :
Function Query(Req As String, Optional Head As Byte = 1) As Long
Dim Cnx As Object, Rst As Object
Dim T As Variant, Col_SQL As Integer, i As Long, j As Long
On Error GoTo errhdlr
Set Cnx = CreateObject("ADODB.Connection")
Cnx.Provider = "MSDASQL"
Cnx.Open "DRIVER={Microsoft Access Driver (*.mdb, *.accdb)}; DBQ="& BDD
If Left(Req, 6) = "SELECT" Then
Set Rst = CreateObject("ADODB.Recordset")
Rst.Open Req, Cnx, 3
Col_SQL = Rst.Fields.Count - 1
If Head = 1 Then
ReDim Rcd(Col_SQL, 0)
For i = 0 To Col_SQL
Rcd(i, 0) = Rst.Fields(i).Name
Next i
End If
Query = Rst.RecordCount
If Not Query = 0 Then
If Head = 1 Then ReDim Preserve Rcd(Col_SQL, Query) _
Else ReDim Rcd(Col_SQL, Query - 1)
ReDim T(Col_SQL, Query - 1)
Rst.MoveFirst
T = Rst.GetRows
For i = 0 To UBound(T, 1)
For j = 0 To UBound(T, 2)
Rcd(i, j + Head) = IIf(IsNull(T(i, j)), "", T(i, j))
Next j
Next i
End If
Else
Cnx.Execute Req
Query = 0
End If
Cnx.Close
Set Rst = Nothing
Set Cnx = Nothing
Exit Function
errhdlr:
If Not Rst Is Nothing Then If Rst.State = 1 Then Rst.Close
If Not Cnx Is Nothing Then If Cnx.State = 1 Then Cnx.Close
Set Rst = Nothing
Set Cnx = Nothing
Query = -1
MsgBox (Err.Description)
End Function
Pour commencer, il sera nécessaire d'initialiser la variable BDD, par exemple dès l'ouverture du fichier Excel :
Private Sub Workbook_Open()
BDD = ActiveWorkbook.Path & "\BaseAccess.accdb"
' ou bien : BDD = "C:\dossier_truc\sous-dossier_bidule\BaseAccess.accdb"
End Sub
Voici ensuite 3 procédures de base (à placer par exemple dans le même module que la fonction précédente), pour inserer, mettre à jour ou supprimer un enregistrement d'une base "BDD":
Sub Insert_DB(Tbl As String, Head As String, Data As String)
Req = "INSERT INTO ["& Tbl & "]"
If Not Head = "" Then Req = Req & " ("& Head & ")"
Req = Req & " VALUES ("& Data & ")"
lig = Sql.Query(Req)
End Sub
Sub Update_DB(Tbl As String, UPD As String, Cond As String)
Req = "UPDATE ["& Tbl & "] SET "& UPD & " WHERE "& Cond
lig = Sql.Query(Req)
End Sub
Sub Delete_DB(Tbl As String, Cond As String)
Req = "DELETE FROM ["& Tbl & "] WHERE "& Cond
lig = Sql.Query(Req)
End Sub
Ainsi, pour créer par exemple la 100ème ligne dans la table "CLIENTS", il suffira d'écrire : (ici la table contient 3 champs : Id, Nom, Prenom)
Insert_DB "CLIENTS", "Id, Nom, Prenom", "100, 'Dupond', 'Jean'"
Vous aurez remarqué : les données textes sont entourées par des quotes simples contrairement aux données numériques.
Pour des dates, elles seront au format mm/jj/aaaa et entourées par des dièses, ex pour le 24 mai 2016 : #05/20/2016#
Pour mettre à jour cette 100ème ligne, on écrira un truc genre:
Update_DB "CLIENTS", "Nom='DuponT', Prenom='Marc'", "Id=100"
Pour supprimer cette 100ème ligne, il suffira d'écrire :
Delete_DB "CLIENTS", "Id=100"
Mais comment savoir que l'enregistrement suivant à créer sera le 100ème?
Et bien il suffit d'interroger la base avant l'Insert via une nouvelle fonction :
Function Get_Max_Id(Tbl As String, Head As String) As Long
Req = "SELECT MAX("& Head & ") FROM ["& Tbl & "]"
Get_Max_Id = Query(Req)
If Rcd(0, 1) = "" Then Get_Max_Id = 0 Else Get_Max_Id = CLng(Rcd(0, 1))
End Function
Le numéro du prochain enregistrement s'obtient alors facilement :
Dim Id_suivant as Long
Id_suivant = Get_Max_Id("CLIENTS", "Id") + 1
On peut donc interroger la base par des SELECT. Un exemple simple et utile, pour alimenter une liste déroulante à partir d'un champs d'une table, une fonction de base :
Function Get_Combo(Tbl As String, Chps As String) As Variant()
Req = "SELECT DISTINCT "& Chps & " FROM ["& Tbl & "]"& _
" ORDER BY "& Chps
If Query(Req, 0) > 0 Then Get_Combo = Application.Transpose(Rcd) _
Else Get_Combo = Array("")
End Function
Pour alimenter un combobox (qui sera donc sans doublon et en ordre alfa : cf DISTINCT et ORDER BY), avec ici la liste des noms des clients, on écrira simplement :
Userform1.ComboBox1.List = Get_Combo("Clients", "Nom")
Pour finir, un exemple de fonction tirée d'une de mes appli, pour montrer que la requête Sql peut inclure des jointures et des champs calculés (on peut aussi faire des agrégations):
Function Get_EvnParRsc(id As Long, dt1 As Date, dt2 As Date, Gen As String, Cat As String) As Variant()
Req = "SELECT E.Genre, E.Categ, E.Deb, E.Fin, E.Hfin-E.Hdeb, R.Nom "& _
" FROM ([Evnmnts] AS E"& _
" INNER JOIN [Assoc] AS A ON A.Id_Ev=E.Id)"& _
" INNER JOIN [Ressources] AS R ON R.Id=A.Id_Re"& _
" WHERE R.Id="& id & _
" AND ((clng(E.Deb) BETWEEN "& CLng(dt1) & " AND "& CLng(dt2) & " )"& _
" OR (clng(E.Fin) BETWEEN "& CLng(dt1) & " AND "& CLng(dt2) & ")"& _
" OR (clng(E.Deb)<"& CLng(dt1) & " AND clng(E.Fin)>"& CLng(dt2) & "))"
If Not Gen = "" Then Req = Req & " AND E.Genre='"& Gen & "'"
If Not Cat = "" Then Req = Req & " AND E.Categ='"& Cat & "'"
Req = Req & " ORDER BY E.Genre ASC, E.Categ ASC"
If Query(Req) > 0 Then Get_EvnParRsc = Application.Transpose(Rcd) _
Else Get_EvnParRsc = Array("")
End Function
Un appel à une fonction de ce genre renvoie un tableau à 2 dimensions qu'on utilise ensuite comme n'importe quel tableau ordinaire.
Pour illustrer mon propos, ci-après une démo constituée de 2 fichiers (à décompresser dans un même dossier de son Pc) : un fichier Excel sans aucune donnée et un fichier accdb contenant 2 tables (et quelques données fictives) :
* une table 'Clients' (Id, Nom, Prénom)
* et une table 'Information' (Id, Id_C, Nte) => Id=le n° de la fiche info, Id_C= le n° de la fiche 'Client'
Les 2 tables sont reliées par un index : Id <=> Id_C, relation un-à-plusieurs classique.
Le nom de la base (+ chemin) est initialisé dans le module 'Thisworkbook'
L'ensemble des fonctions de liaison avec la base Access est dans le module 'Sql'
La démo propose 2 fonctions principales :
* création d'une nouvelle fiche => bouton 'nouvelle fiche'
* consultation/modif des fiches => bouton 'Liste'
Dans la liste : un double-clic sur une ligne ouvre la fiche client pour consultation/modification
Dans la fiche : plusieurs boutons pour ajouter/supprimer une info à relier, enregistrer les modif, supprimer la fiche.
La fiche affiche l'Id, le nom, le prénom et la liste des info reliées au client (Nb : dans cette liste, pour l'affichage, des colonnes sont masquées=>largeur=0)
Le tout est fonctionnel (mais simplex), sans code 'exotique', l'objectif étant de montrer la mise en oeuvre d'une liaison Excel/Access (et non de proposer une appli d'une utilité réelle)
Pierre