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.
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.