Soyez le premier à donner votre avis sur cette source.
Vue 46 360 fois - Téléchargée 7 834 fois
'====================================================================== ' 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
16 déc. 2011 à 14:02
26 janv. 2010 à 13:30
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.
30 mai 2007 à 14:40
Bonne Continuation
23 avril 2007 à 12:46
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.
21 avril 2007 à 20:23
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)
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.