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