Base de données access via dao en vb6 ( exemple complet )

Soyez le premier à donner votre avis sur cette source.

Vue 44 348 fois - Téléchargée 7 528 fois

Télécharger le projet
Commenter

Description

Voici un exemple ( simple mais assez complet ) de manipulation de données provenant d'une base Access sous VB6 en utilisant les Objets DAO.
Dans cet exemple, les procédures habituelles telles que lire, ajouter, modifier ou supprimer des données Access y sont présentes et très largement commentées. Sont inclus également les paramétrages nécessaires pour que VB6 converse correctement avec la base Access.
Vous avez là l'essentiel de ce qu'il faut savoir pour démarrer une application utilisant DAO comme mode d'interrogation de données Access en VB6.
Bon code...

Source / Exemple : 


'======================================================================
' 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

Conclusion :


Si vous créez une base Access selon les indications fournies au début de ce code, vous pouvez tester le code en le copiant directement dans VB6. Ca marche.
Télécharger le projet

Codes Sources

A voir également

Ajouter un commentaire

Commentaires

Signaler
cs_papoun
Messages postés
6
Date d'inscription
mardi 16 mai 2006
Statut
Membre
Dernière intervention
28 novembre 2019
 -
Votre code et votre idée est excellente mais dites moi comment faites vous lorsque deux noms (d'une même famille ) doivent entrer dans la liste ? Car apparement la base se met bien à jour mais le nouveau nom absorde toute la fiche précédente et l'on voit bien apparaître dans la liste déroulante les deux même noms sauf qu'elles ont le même N°de fiche est toute les cases ont pris la même valeur...
Signaler
phdenis63
Messages postés
2
Date d'inscription
jeudi 14 décembre 2006
Statut
Membre
Dernière intervention
26 janvier 2010
 -
Mois aussi, je remercie pour ce code très bien commenté et assez complet en ce qui concerne la gestion de fichier .mdb en visual basic. Cela m'a permis de pouvoir partir de cet exemple pour trouver facilement les parties qui me sont utiles et les adapter dans mes premiers essais de programmation.
Si quelqu'un pouvait donner le même exemple en ADO, ce serait intéressant, mais en attendant, je ferai mes premiers pas avec ce que je trouve, c'est à dire ce code source ici, même s'il utilise DAO.
Signaler
mozaris
Messages postés
1
Date d'inscription
dimanche 20 avril 2003
Statut
Membre
Dernière intervention
30 mai 2007
 -
Merci, ca m'a bp aidé, je te félicite pour la clarté des commentaires, Si tous les codes était commentés comme ca :)
Bonne Continuation
Signaler
Woisard
Messages postés
1
Date d'inscription
samedi 2 juillet 2005
Statut
Membre
Dernière intervention
23 avril 2007
 -
Merci de le faire remarquer, c'est un point que j'avais oublié de préciser : DAO est une ancienne technologie...
Toutefois elle fait partie de l'éventail qui est à disposition des développeurs. Et, même si elle est ancienne, elle fonctionne parfaitement et reste simple d'utilisation. Quant à facile ou moins facile, c'est ce qu'on en fait et comment on l'utilise.
Signaler
ghuysmans99
Messages postés
2501
Date d'inscription
jeudi 14 juillet 2005
Statut
Contributeur
Dernière intervention
5 juin 2016
 1 -
toi t'appeler cromagnon ??

ouais... ce n'est pas de la préhistoire ça ??
utilise plutôt ADO c'est plus récent.
et en + c'est plus facile à utiliser (pour se connecter à la DB)
S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (Woisard)