[VBA/SQL] communication Excel<-->Access

'---------------------------------------------------------------------------------------
' Module    : ModuleBdD
' Author    : Polux
' Date      : 27/10/2008
' Référence : /!\ DECLARER DANS LES REFERENCES :  Microsoft ActiveX Data Object
'---------------------------------------------------------------------------------------

'Obligation de déclaration des variables.
Option Explicit

'/////////////////////////////////'
'// Variables globales du module
'/////////////////////////////////'
Private CmdSql As ADODB.Command
Private NbRs As Long
Public cnx As ADODB.Connection
Private rs As ADODB.Recordset

'////////////////////////////////'
'// Constantes à modifier selon le
'// le cas d'utilisation
'///////////////////////////////'
Public Const bdd = "C:\ma_base.mdb"
'Private Const pw = "pwd"
'Private Const user = "user"

'//////////////////////////////////////
'// Accesseurs des variables globales
'//////////////////////////////////////

'procédure qui stocke le nombre d'enregistrement dans le recordset
Public Sub setNbRs(ByVal nb As Integer)
    NbRs = nb
End Sub

'fonction qui retourne le nombre d'enregistrement dans le recordset
Public Function getNbRs() As Long
    getNbRs = NbRs
End Function

'fonction qui retourne le recordset
Public Function getRs() As ADODB.Recordset
    Set getRs = rs
End Function

'fonction qui retourne la connexion
Public Function getAdoCnx() As ADODB.Connection
    getAdoCnx = AdoCnx
End Function

'fonction qui retourne le chemin de la base de données
Public Function getBdd() As String
    getBdd = bdd
End Function


'//////////////////////////////////
'// Méthodes du module
'//////////////////////////////////

'procédure de connexion à la base de donnée

Public Sub ConnectBdd()
    Set cnx = New ADODB.Connection
    
    cnx.CursorLocation = adUseServer
    'Définition du pilote de connexion
    cnx.Provider = "Microsoft.Jet.OLEDB.4.0"

    'Définition de la chaîne de connexion
    cnx.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & bdd & ";Persist Security Info=False;"
    cnx.ConnectionString = cnx.ConnectionString
   
    'Ouverture de la base de données
    cnx.Open

End Sub

'fonction qui retourne un booléen.
'Paramètres entrées : la requête, l'objet recordset
'Passe la requête à la base de données et récupère le résultat dans le recordset
Public Function OpenRecordset(ByVal requete As String, ByRef rs As ADODB.Recordset) As Boolean
    
On Error Resume Next
  
    On Error Resume Next
    rs.Open requete, ModuleBdD.cnx, , , adCmdText   'passage de la requête
    
    If Err > 0 Then         'en cas d'erreur la fonction retourne Faux et on sort de la fonction
        OpenRecordset = False
        Exit Function
    End If
    
    rs.MoveFirst        'la connexion a réussi, on se place sur le 1er enregistrement
    NbRs = rs.RecordCount   'on compte le nombre de ligne retournée
    OpenRecordset = True  'la fonction retourne Vrai
    
End Function

'fonctions Suivant, Précédent, Premier, Dernier qui retourne un booléen.
'Paramètre entrée : l'objet recordset
'Fonctions qui permettent de parcourir les enregistrements d'un recordset
Public Function RSLireSuivant(ByRef rs As ADODB.Recordset) As Boolean

    On Error Resume Next
    rs.MoveNext
    If rs.EOF Then
        RSLireSuivant = False
        Exit Function
    End If
    
    If Err <> 0 Then
        RSLireSuivant = False
        MsgBox Err.Numbre & ": " & Err.Description
        Exit Function
    End If
    
    RSLireSuivant = True
    
End Function

Public Function RSLirePrecedent(ByRef rs As ADODB.Recordset) As Boolean

    On Error Resume Next
    rs.MovePrevious
    If rs.BOF Then
        RSLirePrecedent = False
        Exit Function
    End If
    
    If Err <> 0 Then
        RSLirePrecedent = False
        Exit Function
    End If
    
    RSLirePrecedent = True
    
End Function

Public Function RSLirePremier(ByRef rs As ADODB.Recordset) As Boolean

    On Error Resume Next
    rs.MoveFirst
    If Err <> 0 Then
        RSLirePremier = False
        Exit Function
    End If
    
    RSLirePremier = True
    
End Function

Public Function RSLireDernier(ByRef rs As ADODB.Recordset) As Boolean

    On Error Resume Next
    rs.MoveLast
    If Err <> 0 Then
        RSLireDernier = False
        MsgBox Err.Number & " : " & Err.Description
        Exit Function
    End If
    
    RSLireDernier = True
    
End Function

'procédure qui ferme la connexion à la base de données
Public Sub CloseBdd()
    AdoCnx.Close
End Sub

'procédure qui ferme le recordset
Public Sub CloseRs()
    rs.Close
End Sub