BASE DE DONNÉES ACCESS VIA DAO EN VB6 ( EXEMPLE COMPLET )

'======================================================================
' Données Access en VB6 en utilisant les objets DAO
'----------------------------------------------------------------------
'Utiliser les objets Access depuis VB6, nécessite de faire référence à une librairie d'objets.
'Attention : selon la version d'Access, les librairies d'objets sont différentes.

'Pour Access 1997, utiliser la librairie : Microsoft DAO 3.51 Object Library
'Pour Access 2003, utiliser la librairie : Microsoft DAO 3.6 Object Library

'1) Comment installer la librairie d'objets DAO nécessaire ?

'   Au Menu, sélectionner:
'     -   Projets,
'     -   Références,
'     -   Sélectionner la référence et cliquer sur OK.
'   Votre projet est prêt pour utiliser les Objets DAO et converser avec Access.

'   L'exemple s'appuie sur :
'   Une base de données nommée « Test.mdb »
'   Une table nommée « Adresses » contenant les champs :
'     - « ID »             AutoNumber  ( qui s'incrémente automatiquement )
'     - « Code »  not Null Integer     ( champ numérique )
'     - « Nom »   not Null String(150) ( 150 caractères alphanumériques )
'     - « PNom »  Null     String(150) ( idem )
'     - « Adr »   Null     String(250) ( 250 caractères alphanumériques )
'     - « CP »    Null     String(5)   ( 5 caractères alphanumériques )
'     - « Ville » Null     String(150) ( 150 caractères alphanumériques )
'     - « mDate » not Null Date()      ( champ Date/Heure )
'     Note : les champs not Null interdisent des valeurs nulles

'2) Se connecter à la base de données Access

'======================================================================
' Déclarations générales
'----------------------------------------------------------------------
' Objet Database pour se connecter à la base de données
Public db As Database
' Objet Recordset pour gérer les enregistrements
Public rst As Recordset

' A l'ouverture de la FORM...
Private Sub Form_Load()
    ' Déclaration des variables
    Dim strPath, strFileName, strPass As String
    ' Initialisation des variables
    strPath = App.Path & "\Datas\" ' App.Path <=> répertoire de l'application
    strFileName = "Test.mdb"
    strPass = "pass"
    '======================================================================
    ' OUVERTURE DE LA BASE DE DONNEES
    ' --> Ne pas oublier de fermer la base à la fermeture de la Form
    '----------------------------------------------------------------------
    ' Exemple avec mot de passe ( strPass = mot de passe de la base Access )
    'Set db = OpenDatabase(strPath & strFileName, False, False, ";pwd=" & strPass & "")
    ' Exemple sans mot de passe
    Set db = OpenDatabase(strPath & strFileName, False, False)
    ' Appel de procédure ( charge les noms de la table dans la liste déroulante )
    ReadCboDatas
End Sub

' Bouton de fermeture de l'application
Private Sub cmdQuitter_Click()
    Unload Me ' Appel de l'événement Unload de la FORM
End Sub

' Evénement Unload ( fermeture ) de la FORM
Private Sub Form_Unload(Cancel As Integer)
    '======================================================================
    ' FERMETURE DE LA BASE DE DONNEES
    '----------------------------------------------------------------------
    db.Close  ' Ferme la base de données
    Unload Me ' Décharge la feuille et ferme l'application
End Sub

'3) Lire les données de la table

Private Sub ReadCboDatas()
    ' Déclarations des variables
    Dim strTable As String
    Dim strSQL As String
    ' Ré-initilaise la liste déroulante
    cboNom.Clear
    cboNom.AddItem ("")
    '======================================================================
    ' LECTURE DES DONNES DE LA TABLE ACCESS
    '----------------------------------------------------------------------
    ' Nom de la table
    strTable = "Adresses"
    ' Requête SQL de sélection des données dans la table
    strSQL = "SELECT Nom FROM " & strTable & " ORDER BY Nom "
    ' Initialise un objet Recordset ( pour gestion des enregistrements )
    Set rst = db.OpenRecordset(strSQL, dbOpenDynaset)
    ' On boucle sur les enregistrements de la table
    While Not rst.EOF
        ' S'il y a une valeur, on l'ajoute à la liste déroulante
        ' NOTE : rst(0) = le 1° champ du Recordset
        If Not IsNull(rst(0)) Then cboNom.AddItem (rst(0))
        ' On peut aussi faire référence au nom du champ dans la requête
        'If Not IsNull(rst("Nom")) Then cboNom.AddItem (rst("Nom"))
        ' On passe à l'enregistrement suivant
        rst.MoveNext
    Wend
    ' On ferme les objets utilisés pour libèrer la mémoire
    rst.Close
    Set rst = Nothing
End Sub

' Lorsqu'on clique sur un nom dans la liste déroulante...
Private Sub cboNom_Click()
    Dim strNom As String
    strNom = cboNom.Text ' Capture du nom sélectionné
    If Trim(strNom) <> "" Then
        ReadData (strNom) ' Appel de procédure ( lecture des données )
    Else
        EraseData ' Appel de procédure ( efface l'écran )
    End If
End Sub

Private Sub ReadData(strNom As String)
    ' Déclarations des variables
    Dim strTable As String
    Dim strSQL As String
    ' Appel de procédure ( on efface l'écran )
    EraseData
    '======================================================================
    ' LECTURE DES DONNES DE LA TABLE ACCESS ( d'après un nom sélectionné )
    '----------------------------------------------------------------------
    ' Correction du nom avec apostrophes éventuels
    ' Note : les apostrophes, dans les requêtes SQL, peuvent provoquer des erreurs
    strNom = Replace(strNom, "'", "''")
    ' Cherche l'enregistrement dans la table
    strTable = "Adresses"
    ' Notez les ' qui entourent la variable strNom ( champ texte )
    strSQL = "SELECT * FROM " & strTable & " WHERE Nom='" & strNom & "' "
    Set rst = db.OpenRecordset(strSQL, dbOpenDynaset)
    While Not rst.EOF
        If Not IsNull(rst(1)) Then txtCode.Text = CStr(rst(1))
        If Not IsNull(rst(2)) Then txtNom.Text = CStr(rst(2))
        If Not IsNull(rst(3)) Then txtPNom.Text = CStr(rst(3))
        If Not IsNull(rst(4)) Then txtAdr.Text = CStr(rst(4))
        If Not IsNull(rst(5)) Then txtCP.Text = CStr(rst(5))
        If Not IsNull(rst(6)) Then txtVille.Text = CStr(rst(6))
        If Not IsNull(rst(7)) Then txtDate.Text = CStr(rst(7))
        rst.MoveNext
    Wend
    ' On ferme les objets utilisés pour libèrer la mémoire
    rst.Close
    Set rst = Nothing
End Sub

'4) Ajouter des données dans la table

' Rré-initialiser les contrôles à l'écran
Private Sub cmdInit_Click()
    EraseData ' Appel de procédure ( qui efface les données écran )
End Sub

' Efface les données à l'écran
Private Sub EraseData()
    txtCode.Text = ""
    txtNom.Text = ""
    txtPNom.Text = ""
    txtAdr.Text = ""
    txtCP.Text = ""
    txtVille.Text = ""
    txtDate.Text = ""
End Sub

Private Sub cmdAdd_Click()
    ' Déclaration des variables
    Dim strTable, strSQL As String
    Dim blnValide As Boolean
    Dim intCode As Integer
    Dim strNom, strPNom, strAdr, strCP, strVille, strDate As String
    ' Initialisation des variables ( + contrôle de saisie )
    blnValide = True
    ' Note : le nom est une valeur obligatoire
    If Trim(txtNom.Text) <> "" Then strNom = Trim(txtNom.Text) Else blnValide = False
    If Trim(txtPNom.Text) <> "" Then strPNom = Trim(txtPNom.Text)
    If Trim(txtAdr.Text) <> "" Then strAdr = Trim(txtAdr.Text)
    If Trim(txtCP.Text) <> "" Then strCP = Trim(txtCP.Text)
    If Trim(txtVille.Text) <> "" Then strVille = Trim(txtVille.Text)
    strDate = Format(Date, "Short Date") ' Date actuelle en format "Short Date"
    '======================================================================
    ' Recherche le Code maximum de la table ( et l'incrémente )
    strTable = "Adresses"
    ' Agrégat SQL qui recherche la valeur maximum de la colonne Code
    strSQL = "SELECT Max(Code) from " & strTable & " "
    Set rst = db.OpenRecordset(strSQL, dbOpenDynaset)
    While Not rst.EOF
        If Not IsNull(rst(0)) Then intCode = CInt(rst(0)) + 1
        rst.MoveNext
    Wend
    rst.Close
    Set rst = Nothing
    '----------------------------------------------------------------------
    ' Si les valeurs sont correctement renseignées, on les ajoute à la table
    If blnValide = True Then
        strTable = "Adresses"
        ' Correction des chaines avec apostrophes éventuels
        ' Note : les apostrophes, dans les requêtes SQL, peuvent provoquer des erreurs
        strNom = Replace(strNom, "'", "''")
        strPNom = Replace(strPNom, "'", "''")
        strAdr = Replace(strAdr, "'", "''")
        strVille = Replace(strVille, "'", "''")
        '======================================================================
        ' AJOUTE LES DONNEES DANS LA TABLE
        '----------------------------------------------------------------------
        ' Requête SQL d'insertion ( modulable selon les valeurs saisies ou pas )
        strSQL = "INSERT INTO " & strTable & " ("
        strSQL = strSQL & "Code, Nom"
        If strPNom <> "" Then strSQL = strSQL & ",PNom"
        If strAdr <> "" Then strSQL = strSQL & ",Adr"
        If strCP <> "" Then strSQL = strSQL & ",CP"
        If strVille <> "" Then strSQL = strSQL & ",Ville"
        strSQL = strSQL & ",mDate"
        strSQL = strSQL & ") VALUES ("
        strSQL = strSQL & intCode & ",'" & strNom & "'"
        If strPNom <> "" Then strSQL = strSQL & ",'" & strPNom & "'"
        If strAdr <> "" Then strSQL = strSQL & ",'" & strAdr & "'"
        If strCP <> "" Then strSQL = strSQL & ",'" & strCP & "'"
        If strVille <> "" Then strSQL = strSQL & ",'" & strVille & "'"
        strSQL = strSQL & ",'" & strDate & "'"
        strSQL = strSQL & ")"
        ' Exécute la requête d'ajout des données dans la table
        db.Execute (strSQL)
        ' On ré-initialise la liste déroulante
        ReadCboDatas
    Else
        MsgBox ("Données de saisies obligatoires manquantes..."), vbExclamation
    End If
End Sub

'5) Modifier les données dans la table

Private Sub cmdChg_Click()
    ' Déclaration des variables
    Dim strTable, strSQL As String
    Dim blnValide As Boolean
    Dim intCode As Integer
    Dim strNom, strPNom, strAdr, strCP, strVille, strDate As String
    ' Initialisation des variables ( + contrôle de saisie )
    blnValide = True
    ' Note : le code et le sont des valeurs obligatoires
    If Trim(txtCode.Text) <> "" Then intCode = CInt(Trim(txtCode.Text)) Else blnValide = False
    If Trim(txtNom.Text) <> "" Then strNom = Trim(txtNom.Text) Else blnValide = False
    If Trim(txtPNom.Text) <> "" Then strPNom = Trim(txtPNom.Text)
    If Trim(txtAdr.Text) <> "" Then strAdr = Trim(txtAdr.Text)
    If Trim(txtCP.Text) <> "" Then strCP = Trim(txtCP.Text)
    If Trim(txtVille.Text) <> "" Then strVille = Trim(txtVille.Text)
    strDate = Format(Date, "Short Date") ' Date actuelle en format "Short Date"
    ' Correction des chaines avec apostrophes éventuels
    ' Note : les apostrophes, dans les requêtes SQL, peuvent provoquer des erreurs
    strNom = Replace(strNom, "'", "''")
    strPNom = Replace(strPNom, "'", "''")
    strAdr = Replace(strAdr, "'", "''")
    strVille = Replace(strVille, "'", "''")
    '----------------------------------------------------------------------
    ' Si les valeurs sont correctement renseignées, on les modifie dans la table
    If blnValide = True Then
        strTable = "Adresses"
        '======================================================================
        ' MODIFIE LES DONNEES DANS LA TABLE
        '----------------------------------------------------------------------
        ' Requête SQL de modification ( modulable selon les valeurs saisies ou pas )
        strSQL = "UPDATE " & strTable & " SET "
        strSQL = strSQL & "Nom='" & strNom & "'"
        If Trim(strPNom) <> "" Then strSQL = strSQL & ",PNom='" & Trim(strPNom) & "'"
        If Trim(strAdr) <> "" Then strSQL = strSQL & ",Adr='" & Trim(strAdr) & "'"
        If Trim(strCP) <> "" Then strSQL = strSQL & ",CP='" & Trim(strCP) & "'"
        If Trim(strVille) <> "" Then strSQL = strSQL & ",Ville='" & Trim(strVille) & "'"
        strSQL = strSQL & ",mDate='" & strDate & "'"
        strSQL = strSQL & " WHERE [Code]=" & intCode & " "
        ' Exécute la requête d'ajout des données dans la table
        db.Execute (strSQL)
        ' On ré-initialise la liste déroulante
        ReadCboDatas
    Else
        MsgBox ("Données de saisies obligatoires manquantes..."), vbExclamation
    End If
End Sub

'6) Supprimer des données dans la table

Private Sub cmdDel_Click()
    ' Déclaration des variables
    Dim strTable As String
    Dim strSQL As String
    Dim strNom As String
    Dim intCode As Integer
    Dim Msg, Style, Title, Response
    ' Si un enregistrement est présent à l'écran...
    If Trim(txtCode.Text) <> "" Then
        ' Initialisation des variables
        intCode = CInt(Trim(txtCode.Text))
        strNom = Trim(txtNom.Text)
        ' Boite de dialogue de confirmation...
        Msg = "Souhaitez-vous continuer? "     ' Message  de la boite de dialogue
        Title = "Supprimer l'enregistrement "  ' Titre de la boite de dialogue
        Style = vbYesNo                        ' Boutons de la boite de dialogue
        ' Demande l'accord de l'utilisateur pour la suppression
        Response = MsgBox(Msg, Style, Title)
        If Response = vbYes Then ' L’utilisateur a choisi Oui.
            strTable = "Adresses"
            '======================================================================
            ' SUPPRIME LES DONNEES DANS LA TABLE
            '----------------------------------------------------------------------
            ' Requête SQL de suppression
            strSQL = "DELETE FROM " & strTable & " WHERE Code=" & intCode & " "
            ' Exécute la requête de suppression des données dans la table
            db.Execute (strSQL)
            ' Appel de procédure ( qui met à jour la liste déroulante )
            ReadCboDatas
            ' Appel de procédure ( qui efface les données à l'écran )
            EraseData
            ' Informe l'utilisateur
            MsgBox (strNom & " a été supprimé de la table."), vbExclamation
        Else ' L’utilisateur a choisi Non.
            MsgBox ("Procédure de suppression annulée."), vbInformation
        End If
    Else
        MsgBox ("Aucun enregistrement sélectionné."), vbCritical
    End If
End Sub

Télécharger le zip