[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

Sub AfficheRequete()
Dim oRs As ADODB.Recordset
Dim Query As String
Dim ok As Boolean
Dim i As Long

   'Construction de la requête
   Query = "Select * From MaTable Where mon_champ = '" & Worksheets(1).Range("C10").Value & " ' "
   'Création de l'objet recordset
   Set oRs = New ADODB.Recordset
   'Numéro de la première ligne pour l'affichage des résultats
   i = 2
   '
   ' On passe la requête à la base. Si le résultat est True on commence la lecture du recordset
   If ModBdd.OpenRecordset(Query, oRs) = True Then
      'On lit le premier enregistrement du recordset
      ok = ModBdd.LirePremier(oRs)
      'Tant que LireSuivant est True on affiche le résultat
      While ok = True
         Worksheets(2).Range("A" & i).Value = oRs.Fields(0) ' 1er champ de l'enregistrement Bdd en cours
         Worksheets(2).Range("B" & i).Value = oRs.Fields(1) ' 2ème champ de l'enregistrement Bdd en cours
         Worksheets(2).Range("C" & i).Value = oRs.Fields(2) ' 3ème champ de l'enregistrement Bdd en cours
         ' etc pour chaque champ de la table
         i = i + 1  'on ajoute une ligne pour afficher la ligne suivante
         ok = ModBdd.LireSuivant(oRs) 'On passe à la ligne suivant
      Wend
   End If
End Sub

Sub OpenRecordset ()
    Dim oDb As DAO.Database, oRs As DAO.Recordset
    Dim sQuery As String
    ' Ouverture de la base de données 
    Set oDb = DBEngine.OpenDatabase ("c:\mabase.mdb")   'mettre le chemin d'accès de la base ou dans Access mettre Set oDb = CurrentDb
    sQuery =  "Select champ1, champ2 From matable"
    ' Ouverture du recordset 
    Set oRs = db.OpenRecordset (sQuery, dbOpenForwardOnly, dbReadOnly)

    'Lecture du recordset
    While Not oRs.EOF
          msgBox oRs.Fields(0) & " " & oRs.Fields(1)
    oRs.MoveNext
    Wend

    ' Fermeture du Recordset
    oRs.Close
    oDb.Close
End Sub