Effectuer des importations d'une base de donnée access vers excel en vba

Soyez le premier à donner votre avis sur cette source.

Vue 12 886 fois - Téléchargée 1 612 fois

Description

Bonjour à tous,

Je vous livre ici ma première source ! Ben oui, je n?ai pas eu le courage de commenter et de livrer tous les codes que j?ai pondus mais sur ce coup là, j'ai pensé à vous car j'ai galéré sur le sujet et je n'ai trouvé aucune source correspondant à mes besoins sur ce site. Vous me direz, j'avais peut être mal cherché (^_^) ! Si c'est le cas, toutes mes excuses !

Revenons en à ma source :
C'est un module qui sert à importer des données d'Access dans un fichier Excel en utilisant l'objet DAO. J'ai utilisé cette méthode car je n'arrivais pas à importer les données d'une base en Access 97 vers un Excel 97 !

Le module est je pense, très bien commenté alors je ne vous ferais pas l'affront de tout ré-expliquer.
Je fournis un Zip contenant un fichier Excel 97 et une base de donnée en Access 97 pour la démonstration mais aussi le fichier du module. De plus, je vous donne le code du module en vrac ci-dessous, comme ça, il y en as pour tous les goûts !

Je suis ouvert à toute critique donc, n'hésitez pas.

J'espère que ce bout de code vous serviras !

@peluche !

Source / Exemple :


Dim Db As DAO.Database 'Objet base de donnée
Dim Rs As Recordset 'Objet qui contient les résultats de la requête
Dim Debut As Date 'Sert à définir le temps d'exécution
Dim Fin As Date 'Sert à définir le temps d'exécution
Dim EnregistrementsParSecondes As Integer 'Nombre d'enregistrements traités par seconde
Dim NbrChamp As Integer 'Nombre de champ par enregistrement
Dim NbrEnr As Integer 'Nombre d'enregistrements traités
Dim Source As String 'C'est la requête
Dim ConditionsDeLaRequeteFinale As String 'Variable qui contiendras les conditions reformatées
Dim Flag As Boolean 'c'est juste un flag, un repère quoi !
Dim L As Integer 'Ligne actuelle
Dim C As Integer 'Colonne actuelle

Public Function ImporterResultatRequeteAccessDansExcel(FichierBaseDeDonneeMDB, NomTable, ConditionsDeLaRequete, NomFichierExcel, NomOngletExcel, Rapport As Boolean)

    'Pour que cette macro fonctionne, il faut référencer au minimum
    '"Microsoft DAO 2.5/3.5 Compatibility Library".
    'Mais la macro fonctionne aussi avec des librairies plus récentes comme
    '"Microsoft DAO 3.0 Object Library" et "Microsoft DAO 3.5 Object Library".
    
    'Cette macro fonctionne sur toutes les versions d'Excel (testé sur Excel 97)
    'et toutes les versions d'Access (testé sur Access 97) vu qu'elles sont rétrocompatibles !
    
    'Cette fonction permet d'importer le résultat d'une requete
    'effectuée dans une base de donnée Access à l'interieur d'un onglet Excel
    
    'Exemple de la commande à lancer pour appeler cette fonction :
    'Call ImporterResultatRequeteAccessDansExcel(ThisWorkbook.Path & "\BDD.mdb", "table_test", "WHERE commentaire=CarteOrange", ThisWorkbook.Name, 1, True)
    
    'Exemple de la commande à lancer pour importer toute une table :
    'Call ImporterResultatRequeteAccessDansExcel(ThisWorkbook.Path & "\BDD.mdb", "table_test", "", ThisWorkbook.Name, 1, True)
    
    '________________________________________________________________________________
    'Enregistrer le momment exact de l'exécution de la fonction
    'Cela sert à calculer le temps d'exécution de la fonction à la fin de celle-ci.
    Debut = Now
    '________________________________________________________________________________
    
    '________________________________________________________________________________
    'Récupérer le nom exact de l'onglet dans lequel l'import sera fait
    NomOngletExcel = Workbooks(NomFichierExcel).Sheets(NomOngletExcel).Name
    '________________________________________________________________________________
    
    '________________________________________________________________________________
    'Activer l'onglet pour l'import
    Workbooks(NomFichierExcel).Sheets(NomOngletExcel).Select
    '________________________________________________________________________________
    
    '________________________________________________________________________________
    'Ouverture de la base de donnée Access.
    Set Db = DBEngine.OpenDatabase(FichierBaseDeDonneeMDB, False, False, "MS Access")
    '________________________________________________________________________________
    
    
    
    '________________________________________________________________________________
    'Ajout de guillemets derrière les "=" de la requete
    ConditionsDeLaRequeteFinale = ""
    Flag = False
    If Not ConditionsDeLaRequete = "" Then
        For i = 1 To Len(ConditionsDeLaRequete)
            If Mid$(ConditionsDeLaRequete, i, 1) = "=" Then
                    
                    Flag = True
                    ConditionsDeLaRequeteFinale = ConditionsDeLaRequeteFinale & Mid$(ConditionsDeLaRequete, i, 1) & Chr(34)
                    
                ElseIf Flag = True And Mid$(ConditionsDeLaRequete, i, 1) = " " Then
                    ConditionsDeLaRequeteFinale = ConditionsDeLaRequeteFinale & Chr(34) & Mid$(ConditionsDeLaRequete, i, 1)
                    Flag = False
                    
                ElseIf Flag = True And Not i = Len(ConditionsDeLaRequete) Then
                    ConditionsDeLaRequeteFinale = ConditionsDeLaRequeteFinale & Mid$(ConditionsDeLaRequete, i, 1)
                    
                ElseIf Flag = True And i = Len(ConditionsDeLaRequete) Then
                    ConditionsDeLaRequeteFinale = ConditionsDeLaRequeteFinale & Mid$(ConditionsDeLaRequete, i, 1) & Chr(34)
                    Flag = False
                    
                ElseIf Flag = False Then
                    ConditionsDeLaRequeteFinale = ConditionsDeLaRequeteFinale & Mid$(ConditionsDeLaRequete, i, 1)
                    
            End If
        Next
    End If
    '________________________________________________________________________________
    
    
    '________________________________________________________________________________
    'Définition de la requête qui seras effectuée dans la Base de données
    If Not ConditionsDeLaRequete = "" Then
            Source = "SELECT * FROM " & NomTable & " " & ConditionsDeLaRequeteFinale
        Else
            Source = "SELECT * FROM " & NomTable
    End If
    '________________________________________________________________________________
    
    '________________________________________________________________________________
    'Effectuer la requête
    Set Rs = Db.OpenRecordset(Source)
    '________________________________________________________________________________
    
    '________________________________________________________________________________
    'Définir le nombre d'enregistrements et de champs qui résultent de la requête.
    '
    'Les enregistrements sont les lignes de la base de données et les
    'champs sont en fait les colonnes.
    Rs.MoveLast
    NbrEnr = Rs.RecordCount
    Rs.MoveFirst
    NbrChamp = Rs.Fields.Count
    '________________________________________________________________________________
    
    '________________________________________________________________________________
    'Ecrire les nom des champs en entête dans l'onglet du fichier Excel
    L = 1
    For C = 0 To NbrChamp - 1
        Workbooks(NomFichierExcel).Sheets(NomOngletExcel).Cells(L, C + 1) = Rs.Fields(C).Name
    Next
    '________________________________________________________________________________
    
    '________________________________________________________________________________
    'Ecrire les résultats de la requête dans l'onglet du fichier Excel
    For L = 1 To NbrEnr
        For C = 0 To NbrChamp - 1
            Workbooks(NomFichierExcel).Sheets(NomOngletExcel).Cells(L + 1, C + 1) = Rs.Fields(C).Value
        Next
    Rs.MoveNext
    Next
    '________________________________________________________________________________
    
    '________________________________________________________________________________
    'Cela sert à calculer le temps d'exécution de la fonction à la fin de celle-ci.
    Fin = Now
    '________________________________________________________________________________
    
    
    '________________________________________________________________________________
    'Mettre l'entête en gras, activer le filtrage automatique et redimensionner
    'les colonnes automatiquement.
    Rows("1:1").Select
    Selection.Font.Bold = True
    Selection.AutoFilter
    Cells.Select
    Selection.Columns.AutoFit
    Cells(2, 1).Select
    Cells(1, 1).Select
    '________________________________________________________________________________
    
    '________________________________________________________________________________
    'Fermer la base de donnée
    Rs.Close
    Db.Close
    '________________________________________________________________________________
    
    '________________________________________________________________________________
    'Libérer les objet utilisés pour la base de donnée
    Set Rs = Nothing
    Set Db = Nothing
    '________________________________________________________________________________
    
    '________________________________________________________________________________
    'Afficher le rapport final si il est demandé
    If Rapport = True Then
        Tps = DateDiff("s", Debut, Fin)
        If Tps > 0 Then
                EnregistrementsParSecondes = NbrEnr / Tps
            Else
                EnregistrementsParSecondes = NbrEnr
        End If
        MsgBox "Base de donnée : " & FichierBaseDeDonneeMDB & Chr(10) & _
               "Requête : " & Source & Chr(10) & Chr(10) & _
               "Fichier Excel : " & NomFichierExcel & Chr(10) & _
               "Nom de l'onglet : " & NomOngletExcel & Chr(10) & Chr(10) & _
               "Temps d'exécution : " & Tps & " secondes" & Chr(10) & _
               "Nombre d'enregistrements : " & NbrEnr & Chr(10) & _
               "Nombre d'enregistrements traités par secondes : " & EnregistrementsParSecondes & Chr(10) _
               , vbInformation, "Rapport de la requête"
    End If
    '________________________________________________________________________________
    
End Function

Conclusion :


N'hésitez pas à commenter ma source !

Codes Sources

A voir également

Ajouter un commentaire

Commentaires

Messages postés
10
Date d'inscription
mercredi 30 mai 2007
Statut
Membre
Dernière intervention
11 juin 2007

Malheureusement je peux pas trop m'amuser avec ce genre de fichier sur le PC de la boite...

Mais si tu trouves une autre solution hesites pas a faire signe, ton code avait l'air interessant ;)
Messages postés
65
Date d'inscription
mercredi 7 janvier 2004
Statut
Membre
Dernière intervention
11 septembre 2012

Je pense que vous devez avoir un problème d'instalation du JET 3.5 de Microsoft.

Pour régler votre problème, il vaut mieux essayer de le réinstaller en le téléchargeant ici :

http://www.download.com/Microsoft-Jet-Database-Engine-3-5/3000-2114_4-4238277.html

Sinon, j'ai trouvé un article pour vérifier l'installation du pilote JET 3.5 chez Microsoft ici :

http://support.microsoft.com/kb/240377

Je pense que ça devrais suffire à résoudre votre problème.
Messages postés
10
Date d'inscription
mercredi 30 mai 2007
Statut
Membre
Dernière intervention
11 juin 2007

Bin j'ai le meme soucis et meme en chargeant les differentes librairies ca ne marche pas.

J'ai essaye avec la version 3.5 et 3.6 ainsi qu'avec Microsoft DAO 2.5/3.5 Compatibility Library.
Toujours le meme message d'erreur...
Messages postés
95
Date d'inscription
samedi 13 novembre 2004
Statut
Membre
Dernière intervention
26 septembre 2008

Ben en faite c'est pour un autre problème mais c'est quand même de cette librairie dont j'ai besoin car c'est pour convertir un base access 2000 en 2003 et comme elle dépendait de cette librairieet c'est la seul qui permet la compatibilité :/ et je ne l'ai pas dans "OUTIL > references"
Messages postés
65
Date d'inscription
mercredi 7 janvier 2004
Statut
Membre
Dernière intervention
11 septembre 2012

Tu le trouve dans le menu "OUTIL > Références..." de ton éditeur VBA dans Excel. Maintenant il y a eu de nouvelles version du DAO donc prend la plus avancée, se sera le mieux. (Acutellement sur ma machine je vois une version 3.6)
Afficher les 15 commentaires

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.