Bonjour à tous,
Pour lire des données Access dans excel, c'est assez simple.
Ci-joint mon code que j'utilise régulièrement pour extraire la totalité d'un .accdb vers Excel
Ce code demande à pointer sur un fichier .acdb ou .mdb, puis crée autant d'onglets que de tables et colle le contenu de chaque table dans chacun des onglets correspondant.
Dans chaque onglet la première ligne correspond au codage du type des données de la colonne.
Pour utiliser ce code, coller-le dans un module quelconque, et exécuter la procédure 'lister_tables'.
Pas de référence à cocher, pas de blabla, ça fait le job.
Après pour ajouter des filtres, il suffit de modifier la ligne de commande SQL
Pierre
Ps : le code prend en charge l'éventualité d'un mot de passe protégeant la base
Option Explicit
' ***********************************************************************
' ***** *****
' ***** CODE PierreP56 : http://tatiak.canalblog.com/ *****
' ***** *****
' ***********************************************************************
Public Const PRVD = "PROVIDER=MICROSOFT.JET.OLEDB.4.0;DATA SOURCE="
Sub lister_tables()
Dim BDD As String, msg As String, Mdp As String, Req As String
Dim Cnx As Object, Cat As Object, Tbl As Object
BDD = NDF_A_LIRE
msg = "Saisir le mot de passe d'accès à la base (optionnel)" & vbCrLf & "ou cliquez sur 'Annuler'"
Mdp = InputBox(msg, "MOT DE PASSE")
If Not BDD = "Faux" Then
Set Cnx = CreateObject("ADODB.Connection")
Req = PRVD & BDD
If Not Mdp = "" Then Req = Req & ";Jet OLEDB:Database Password=" & Mdp & ";"
Cnx.Open Req
Set Cat = CreateObject("ADOX.Catalog")
Set Cat.activeconnection = Cnx
Set Tbl = CreateObject("ADOX.Table")
For Each Tbl In Cat.Tables
If Tbl.Type = "TABLE" Then
Sheets.Add After:=ActiveSheet
ActiveSheet.Name = Tbl.Name & "_"
lirecontenu BDD, Tbl.Name
End If
Next
Cnx.Close
Set Cnx = Nothing
Set Cat = Nothing
Set Tbl = Nothing
End If
End Sub
Sub lirecontenu(NDF As String, Tbl As String)
Dim Requete As String, result As Integer
Requete = "SELECT * FROM [" & Tbl & "] "
result = Import.Query(Requete, NDF)
End Sub
Function NDF_A_LIRE() As String
ChDrive (Left(ActiveWorkbook.Path, 1))
ChDir ActiveWorkbook.Path
NDF_A_LIRE = Application.GetOpenFilename("Fichiers Access,*.mdb;*.accdb")
End Function
' ***** REQUETEUR SQL *****************************************************************************
Function Query(Requete As String, BDD As String) As Integer
Dim Cnx As Object, Rst As Object
Dim Col_SQL As Integer, i As Long, j As Integer
On Error GoTo errhdlr
Set Cnx = CreateObject("ADODB.Connection")
Cnx.Open PRVD & BDD
Set Rst = CreateObject("ADODB.Recordset")
Rst.Open Requete, Cnx, 3
Query = Rst.RecordCount
Col_SQL = Rst.Fields.Count - 1
ReDim Ent(Col_SQL)
For i = 0 To Col_SQL
ActiveSheet.Cells(1, i + 1).Value = Rst.Fields(i).Type
ActiveSheet.Cells(2, i + 1).Value = Rst.Fields(i).Name
Next i
If Not Query = 0 Then
Rst.movefirst
ActiveSheet.Range("A3").CopyFromRecordset Rst
End If
Cnx.Close
Set Cnx = Nothing
Set Rst = Nothing
Exit Function
errhdlr:
Query = -1
If Not Rst Is Nothing Then
If Rst.State = 1 Then Rst.Close
Set Rst = Nothing
End If
If Not Cnx Is Nothing Then
If Cnx.State = 1 Then Cnx.Close
Set Cnx = Nothing
End If
Debug.Print Err.Number & " " & Err.Description & vbCrLf & "Requête : " & Requete
End Function
' *************************************************************************************************