Option Explicit ' ============================================================================= '' ' Module Mdl_1_BDD_Office '
Version 1.1 '

Création : Ce module permet de s'interfacer avec un fichier vu comme ' une base de données en utilisant le modèle ADODB. Le fichier peut ' être un fichier ACCESS (.accdb) ou Excel (.xls, .xlsx, .xlsm) ' ' @require Microsoft Excel 2007 ' @require Microsoft ADO Ext 2.8 for DLL and security ' @require Microsoft ActiveX Data Object 2.8 Library ' @require Microsoft ActiveX Data Object Recordset 2.8 Library ' @require Microsoft Scripting RunTime ' ============================================================================= ' Constantes accès BDD Const blnCONNEXION_BDD_KO As Boolean = False Const blnCONNEXION_BDD_OK As Boolean = True ' ' Type pour définir une BDD Public Type udtBaseDeDonnees connexion As ADODB.Connection enregistrement As ADODB.Recordset nomComplet As String nomBase As String option As String End Type ' ============================================================================= '' ' Fonction blnConnecterBDD '
Etablit une connexion à une base de données. ' @param p1 Pointeur vers une structure définissant la base de données et les ' éléments nécessaires à la connexion et aux requêtes. ' @return true = connecté ou false = Non connecté ' @remarks : le parametre option est positionné selon la demande de la base de ' données. ' ' ============================================================================= Public Function blnConnecterBDD(maBase As udtBaseDeDonnees) As Boolean Dim blnEtatConnexion As Boolean Dim strConnect As String On Error GoTo ErrConnexion blnConnecterBDD = False If maBase.connexion Is Nothing Then Set maBase.connexion = New ADODB.Connection End If blnEtatConnexion = maBase.connexion.State If blnEtatConnexion = blnCONNEXION_BDD_OK Then blnConnecterBDD = True Else If InStr(1, LCase(maBase.nomBase), ".xlsx") Or InStr(1, LCase(maBase.nomBase), ".xlsm") Then maBase.connexion.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & maBase.nomComplet & _ ";Extended Properties=""Excel 12.0;" & maBase.option & """" ElseIf InStr(1, LCase(maBase.nomBase), ".xls") Then maBase.connexion.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;;Data Source=" & maBase.nomComplet & _ ";Extended Properties=""Excel 8.0;" & maBase.option & """" ElseIf InStr(1, LCase(maBase.nomBase), ".accdb") Then maBase.connexion.Provider = "Microsoft.ACE.OLEDB.12.0" maBase.connexion.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & maBase.nomComplet Else maBase.connexion.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & maBase.nomComplet End If maBase.connexion.Open blnConnecterBDD = True End If Exit Function ' gestion des cas d'erreurs ErrConnexion: MsgBox Date & " " & Time & " BASE : " & maBase.nomBase & " - ERREUR : " & ERROR.Number & " " & ERROR.Description, _ vbCritical, "Erreur de connexion " blnConnecterBDD = False End Function ' ============================================================================= '' ' Fonction blnDeconnecterBDD '
Se déconnecte d'une base de données. ' @param p1 Pointeur vers une structure définissant la base de données. ' @return true = Déconnecté ou false = Non déconnecté ' ' ============================================================================= Public Function blnDeconnecterBDD(maBase As udtBaseDeDonnees) As Boolean On Error GoTo ErrDeconnexionBDD If Not maBase.enregistrement Is Nothing Then If maBase.enregistrement.State <> adStateClosed Then maBase.enregistrement.Close End If Set maBase.enregistrement = Nothing End If If Not maBase.connexion Is Nothing Then 'on ferme la connexion à la base de données maBase.connexion.Close 'on efface le contenu des objets de connexion Set maBase.connexion = Nothing blnDeconnecterBDD = True Exit Function End If ' gestion des cas d'erreurs ErrDeconnexionBDD: MsgBox Date & " " & Time & " BASE : " & maBase.nomBase & " - ERREUR : " & ERROR.Number & " " & ERROR.Description, _ vbCritical, "Erreur de déconnexion " blnDeconnecterBDD = False End Function ' ============================================================================= '' ' Fonction blnExecuterRequete '
Exécute une requête sur une base de données. ' @param p1 Requete à exécuter (en language SQL). ' @param p2 Pointeur vers une structure définissant la base de données. ' @return true = requete exécutée ou false = erreur sur l'exécution requete ' ' ============================================================================= Function blnExecuterRequete(maRequete As String, maBase As udtBaseDeDonnees) As Boolean On Error GoTo ErrRequeteBDD 'test s'il y a une requete dans maRequete If maRequete = "" Then blnExecuterRequete = False ElseIf blnConnecterBDD(maBase) Then If maBase.enregistrement Is Nothing Then Set maBase.enregistrement = New ADODB.Recordset Else maBase.enregistrement.Close End If maBase.enregistrement.Open maRequete, maBase.connexion, adOpenKeyset, adLockOptimistic blnExecuterRequete = True End If Exit Function ' gestion des cas d'erreurs ErrRequeteBDD: MsgBox Date & " " & Time & " BASE : " & maBase.nomBase & " - ERREUR : " & ERROR.Number & " " & ERROR.Description, & vbnewline & _ vbtab & "pour la requête : " & maRequete, vbCritical, "Erreur d'exécution de requête " blnExecuterRequete = False End Function