Utilisation ado avec une base ms access
Base MS Access & ADO (VB6) V1.1
Ajouter le composant ADO à votre projet VB
Allez dans Projet > Références puis cocher Microsoft ActiveXDataObjetcs 2.x Library
Pour l'exemple, supposons que vous choisissez Microsoft ActiveX DataObjetcs 2.8 Library
Connexion
Pour vous connecter à votre Base de Donnée, vous devez établir une connexion.
Je vous conseille d'écrire les codes ci-dessous dans un module, par exemple SQL puisque les codes vont vous servir dans d'autres projets.
L'objet qui permet de connecter la base est ADODB.Connection et utilise une chaîne de connexion. Je vous propose une fonction de connexion toute faite dont vous pouvez modifier la chaîne de connexion à votre guise. Le module commence donc ainsi :
Option Explicit
Option Compare Binary
Private dbPassWord As String
Public cnx As New ADODB.Connection
Private URL_BASE As String
Public Sub ConnexionBase(Optional ByVal cheminBase As String)
Dim ChaineConnexion As String
If cheminBase <> vbNullString Then URL_BASE = cheminBase
On Error GoTo erreur
ChaineConnexion = "Provider=Microsoft.Jet.OLEDB.4.0;DataSource=" & _
URL_BASE & ";Persist Security Info=False;" & _
"JetOLEDB:Database Password=" & dbPassWord
cnx.Open ChaineConnexion
Exit Sub
erreur:
If cnx.State Then cnx.Close
MsgBox "Erreur de connexion à votre base " & vbCrLf & URL_BASE, vbCritical, _
"Echec Connexion"
End Sub
' Permet de définir le mot de passe pour se connecter à la base
Public Sub setPasswordBase(Optional s As String = "") : dbPassWord = s : End Sub
' Permet de définir le chemin d'accès à la base
Public Sub setURLase(Optional s As String = "") : URL_BASE = s : End Sub
Concrètement, si votre base nécessite un mot de passe, vous devez le définir (une seule fois durant l'exécution de votre projet en utilisant setPasswordBase.
Par exemple, pour définir le mot de passe 1j2ep9
Call setPasswordBase("1j2ep9")
De la même façon, vous devez renseigner au moins une fois le chemin d'accès complet à la base : c:\base.mdb (une seule fois suffit).
Call setURLase("c:\base.mdb")
Ou alors lors de la première connexion :
Call ConnexionBase("c:\base.mdb")
Vous aurez compris que pour vous connecter à la base, il vous suffit de faire
Call ConnexionBase()
Déconnexion
Petit aparté, il existe deux écoles quand à l'ouverture et la fermeture de la connexion.
Une première méthode consiste à ouvrir la connexion à la base dès le lancement du projet et à la fermer lorsque l'appli se termine. Personnellement, je ne suis pas fan de cette méthode : C'est inutile de laisser la base ouverte lorsque l'on fait rien dessus.
L'intérêt principal de cette méthode et d'économiser le temps de connexion.
Je préfères ouvrir la base lorsque les traitements le demandent (ouvrir le plus tard possible) et la fermer en fin de traitement. Bien sur, inutile d'ouvrir et de fermer la connexion pour chaque requête : pour une série de requêtes autant ouvrir à l'exécution de la première et fermer après la dernière.
A vous de choisir votre méthode...
Bon,maintenant comment fermer la connexion, c'est tout simple
Cnx.Close
Je n'ai pas fait de méthode volontairement puisqu'il s'agit d'une ligne à taper... mais ça serait plus propre de définir une méthode et de placer cnx en private (encapsulation des données)
Ajouter des données
A ce stade, quelques précisions sont nécessaires sur le formatage des informations.
Les dates
MSAccess utilise le format américain (mm/dd/yyyy) et il est nécessaire d'encadrer les dates par des #. Je vous propose donc pour chaque utilisation d'une date d'appeler la fonction suivante :
' Converti une date au format jj/mm/aaaa au format US : mm/jj/aaaa
Public Function DateSQL(ByVal datej As String) As String
Dim jour() As String
Dim poSp As Integer
' Suppression de l'heure si existe
poSp = InStr(1, datej, " ")
If poSp > 0 Then datej = Mid(datej, 1,poSp - 1)
' Mise en forme
jour = Split(datej, "/")
Dim nbVal As Single
nbVal = UBound(jour)
If nbVal = 2 Then
DateSQL = Chr(35) & jour(1) & "/" & jour(0) &"/" & jour(2) & Chr(35)
ElseIf nbVal = 1 Then
DateSQL = Chr(35) & jour(0) & "/01/" & jour(1) &Chr(35)
Else
DateSQL = "#01/01/" & datej & Chr(35)
End If
End Function
Elle fait quelques traitements supplémentaires mais devrait vous donner entière satisfaction.
Utilisation :
DateSQL(variableContenantUneDate)
Les chaînes de caractères
En SQL, le simple quotte sert à délimiter les chaînes, il faut donc protéger les simples quottes au sein de chaîne, par exemple, enr emplaçant les simple quotte par deux simples quottes. A cet effet, je vous propose la fonction ci-dessous :
Function TXTVersSQL(message As String) As String message = Replace(message,"'", "''") TXTVersSQL = Chr(39) & message & Chr(39) End Function
Utilisation :
TXTVersSQL("l'école de l'étang") 'vas renvoyer "'l''école de l''étang'"
Les booléens
MSAccess manipule les booléens -1 = Oui et 0 = non. De la même façon, voici une méthode qui vous permettra de vous simplifier les traitements :
Public Function BoolSQL(ByVal bBool As Boolean) As String : BoolSQL = IIf(bBool,"-1", "0") : End Function
Utilisation :
BoolSQL(True) 'renvoi donc -1
Pour afficher un Booléen, autant utiliser une méthode qui converti la valeur Access en texte comme par exemple Oui/Non :
Public Function Affich_Bool(ByVal b As Boolean) As String : Affich_Bool= IIf(b, "Oui", "Non"): End Function
Ajouter un élément dans la base
Bon maintenant, nous sommes prêt à insérer un élément : Supposons que vous voulez ajouter un nom, un date, un booléen.
Soit la table USERS telle que :
| id | (numéro auto) |
| nom | (texte) |
| ddn | (date) |
| admin | (booléen) |
La requête SQL s'écrit donc :
INSERT INTO USERS (nom, ddn, admin) VALUES (les valeurs)
Créons la méthode pour ajouter un USER :
Public Function ajoutUser(ByVal Mynom as String, ByVal Myddn as Date, ByVal Myadmin as Boolean) As Boolean Dim sql As String sql = "INSERT INTO USERS (nom, ddn, admin) VALUES ( " sql = sql & TXTVersSQL(Mynom) & ", " sql = sql & DateSQL (Myddn) & ", " sql = sql & BoolSQL(Myadmin) & ");" On Error GoTo erreur Call ConnexionBase cnx.Execute sql cnx.Close ajoutUser = True Exit Function erreur: If cnx.State Then cnx.Close 'Debug.Print sql ajoutUser = False End Function
Au passage, cette fonction permet de tester si la requête c'est bien passée. Ainsi dans votre code :
If ajoutUser(txtNom.Text, dtpNaiss.Value, chkAdmin.Value = vbChecked) Then
MsgBox "Personne ajoutée", vbInformation, "Succés"
Else
MsgBox "Vérifiez votre saisie",vbInformation, "Echec"
End If
notez que l'id de la personne est automatiquement généré par Access et qu'on n'a pas besoin de le préciser.
Les requêtes de modifications (UPDATE) de suppressions (DELETE) fonctionnent suivant le même schéma. Je vous renvoie à de la documentation en ligne pour toutes informations relatives à leurs syntaxes.
C'est bien joli, mais supposons que vous ayez besoin de récupérer l'id du dernier élément ajouté.
Récupérer des informations depuis la base
A ce stade, nous allons effectuer une requête de type SELECT afin de récupérer des enregistrements. Ils sont renvoyés sous forme de ligne chacune étant découpée en colonne (autant de colonnes que de champs entre les instructions SELECT et FROM).
L'objet permettant de récupérer des résultats d'un SELECT est le RecordSet (jeu d'enregistrement)
Public Function getLastIDUser(current As client) As Integer
Dim sqlid As String
Dim rs As ADODB.Recordset 'Déclarer le RecordSet
Dim id As Integer
id = 0
sqlid = "SELECT MAX(id) AS LASTID FROM USERS;"
On Error GoTo erreur
Call ConnexionBase
cnx.Execute sql
Set rs = New ADODB.Recordset 'Créer une instance de RecordSet
rs.Open sqlid, cnx, adOpenStatic, adLockReadOnly ' L'ouvrir
id = rs("LASTID") ' Accés à la valeur
rs.Close 'Fermer le RecordSet
Set rs = Nothing 'Libérer la mem. (tout obj avec utilisé avec new doit être libéré avec set .. Nothing)
cnx.Close
getLastIDUser = id
Exit Function
erreur:
If cnx.State Then cnx.Close
getLastIDUser = -1
End Function
Et comment faire lorsque l'on a plus d'une ligne à afficher ?
Vous avez une méthode RecordCount qui vous permet de connaître le nombre de lignes dans le Recordset. Pour Passer à la ligne suivant, MoveNext est fait pour ça.
Voyons ça en pratique, et listons tous les USERS que nous ajoutons à une MSFlexGrid :
Public Sub Afficher_Users(flex As MSFlexGrid)
Dim sql As String
Dim rs As ADODB.Recordset
Dim I As Integer, total As Integer
Dim txt As String
sql ="SELECT ID, NOM, DDN, ADMIN " & _
"FROM USERS " & _
"ORDER BY NOM ASC;"
'Debug.Print sql
On Error GoTo erreur
Set rs = New ADODB.Recordset
Call ConnexionBase
rs.Open sql, cnx, adOpenStatic, adLockReadOnly
'Mise en forme de la flex
With flex
.Visible = False
.Rows = 1 'Vider la flex
.Cols = 4
.Row = 0 'Se placer à la premiere ligne
For i = 0 To .Cols - 1
.col = I 'Se balader de colone en colone
Select Case i
Case0:
.Text = "ID"
.ColAlignment(i) = flexAlignLeftCenter
Case 1:
.Text = "Nom"
.ColAlignment(i) = flexAlignLeftCenter
Case 2:
.Text = "DDN"
.ColAlignment(i) = flexAlignLeftCenter
Case 3:
.Text = "Admin"
.ColAlignment(i) = flexAlignLeftCenter
End Select
.CellAlignment = flexAlignCenterCenter
Next i
End With
total = rs.RecordCount
For i = 1 To total
txt =rs("ID") & vbTab
txt = txt& rs("NOM") & vbTab
txt = txt& rs("DDN") & vbTab & Affich_Bool(rs("ADMIN"))
flex.AddItem txt
rs.MoveNext 'Passer à la ligne suivante du Recordset
Next i
rs.Close
Set rs = Nothing
cnx.Close
flex.Visible = total > 0
Exit Sub
erreur:
If cnx.State Then cnx.Close
End Sub
Quelques remarques :
- Pour le debug, mieux vaut prévoir un Debug.Print sql.
- Ensuite, pour optimiser les traitements, il est préférable de stocker la valeur du rs.RecordCount (puisqu'elle est fixe) plutôt que l'utiliser dans la boucle. En effet, cette seconde méthode est juste mais vous aller faire appel à RecordCount à chaque tour de boucle pour rien et gaspiller du temps processeur.
- Lorsque la base contient des valeur nulles (null autorisé) vous risquez d'avoir un bug. Personnellement, je n'aime pas trop autoriser les valeurs nulles. Mais au cas où, vous pouvez protéger la récupération desvaleurs en encadrant tous les rs("..") par rs_to_flexCell(rs("..")) :
Public Function rs_to_flexCell(ByVal s As Variant) As String
rs_to_flexCell= IIf(Not IsNull(s) And s <> "", s, " ")
End Function
La boucle for devient alors, si le nom est facultatif
For i = 1 To total
txt = rs("ID") & vbTab
txt = txt& rs_to_flexCell(rs("NOM")) & vbTab
txt = txt& rs("DDN") & vbTab & Affich_Bool(rs("DATES"))
flex.AddItem txt
rs.MoveNext 'Passer à la ligne suivante du Recordset
Next i
- Supposons maintenant que vous vouliez disposez en en-tête de colonne le nom des champs tels qu'ils sont dans la base. Rs.Fields vous permet d'y accéder. Ainsi, la génération des en-têtes de la flex s'écrit :
Dim nbCol As Integer
nbCol = rs.Fields.Count
'Afficher les Nom des champs dans la flex
.Row = 0
.Cols = nbCol
For i = 0 To nbCol - 1
.Col = i
.Text = rs.Fields(i).Name
.CellAlignment = flexAlignCenterCenter
.ColAlignment(i) = flexAlignLeftCenter
Next i
Les champs sont affichés dans l'ordre que vous avez défini entre le SELECT et le FROM.
Afficher_Users s'écrit donc :
Public Sub Afficher_Users(flex As MSFlexGrid)
Dim sql As String
Dim rs As ADODB.Recordset
Dim i As Integer, total As Integer
Dim txt As String
Dim nbCol As Integer
sql ="SELECT ID, NOM, DDN, ADMIN " & _
"FROM USERS " & _
"ORDER BY NOM ASC;"
'Debug.Print sql
On Error GoTo erreur
Set rs = New ADODB.Recordset
Call ConnexionBase
rs.Open sql, cnx, adOpenStatic, adLockReadOnly
'Mise en forme de la flex
With flex
.Visible = False
.Rows = 1 'Vider la flex
.Cols = 4
'Afficher les Nom des champs dans la flex
.Row = 0
nbCol = rs.Fields.Count
.Cols = nbCol
For i = 0To nbCol - 1
.Col = i
.Text = rs.Fields(i).Name
.CellAlignment = flexAlignCenterCenter
.ColAlignment(i) = flexAlignLeftCenter
Next i
End With
total = rs.RecordCount
For i = 1 To total
txt = rs("ID") & vbTab
txt = txt& rs("NOM") & vbTab
txt = txt& rs("DDN") & vbTab & Affich_Bool(rs("DATES"))
flex.AddItem txt
rs.MoveNext 'Passer à la ligne suivante du Recordset
Next i
rs.Close
Set rs = Nothing
cnx.Close
flex.Visible = total > 0
Exit Sub
erreur:
If cnx.State Then cnx.Close
End Sub
Trouver le mot de passe d'une base MS Access
Vous voulez autoriser les utilisateurs de votre application à mettre un mot de passe sur leur base. Je vous propose le code ci-dessous afin de le trouver et de vous connecter facilement (ce code n'est pas de moi mais fonctionne très bien) :
'===========================================
' Récupérer le mot de pass de la base
Function xGetAccessPwd(ByVal FileName As String) As String
Dim n As Long, s1 As String * 1, s2 As String * 1
Dim dbname As String
Dim passw As String
Dim bckPass As String
Dim mask97 As String
Dim mask2k As String
Dim priv As String
Dim priv2 As String
Dim prviput As Boolean
Dim TrebaObavestiti As Boolean
Dim cnn1 As ADODB.Connection
mask97 = Chr(&H4E) & Chr(&H86) & Chr(&HFB) & Chr(&HEC) & _
Chr(&H37) & Chr(&H5D) & Chr(&H44) & Chr(&H9C) & _
Chr(&HFA) & Chr(&HC6) & Chr(&H5E) & Chr(&H28) & _
Chr(&HE6) & Chr(&H13)
mask2k = Chr(&H4E) & Chr(&H99) & Chr(&HEC) & Chr(&H42) & _
Chr(&H9C) & Chr(&HD9) & Chr(&H28) & Chr(&HC) & _
Chr(&H8A) & Chr(&H4B) & Chr(&H7B) & Chr(&HEA) & _
Chr(&HDF) & Chr(&H68) & Chr(&H13) & Chr(&HD0) & _
Chr(&HB1) & Chr(&H2B) & Chr(&H79) & Chr(&H8D) & _
Chr(&H7C)
' set the masking characters
dbname = FileName
passw = ""
Open dbname For Binary As #1 ' open the database
Seek #1, &H42
For n = 1 To 21
' actual password recovery module
s1 = Mid(mask2k, n, 1)
s2 = Input(1, 1)
If (Asc(s1) Xor Asc(s2)) <> 0 Then
passw = passw & Chr(Asc(s1) Xor Asc(s2))
End If
If n <> 1 Then s2 = Input(1, 1)
Next
Close 1
prviput = True
TrebaObavestiti = True
If passw = vbNullString Then
' MsgBox "No Password Found"
xGetAccessPwd = passw
Else
Set cnn1 = New Connection
cnn1.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"DataSource=" & FileName & ";" & _
"Persist Security Info=False" & ";"
On Error Resume Next
'Before we get into rush, let see if there is password
If cnn1.State = adStateClosed Then cnn1.Open
If Err.Number = -2147217843 Then
'this means that password exists
'Debug.Print "password protected..."
Else
If Err.Number = 0 Then
'MsgBox "No Password Found", vbInformation
xGetAccessPwd = ""
End If
End If
Err.Clear
'Lets try open it with masked password in first step,
'this happens very rare
cnn1.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"DataSource=" & FileName & ";" & _
"Persist Security Info=False;" & _
"Jet OLEDB:Database Password=" & passw & ";"
s1 = Chr(0)
bckPass = passw
Screen.MousePointer = vbHourglass
On Error GoTo EH
'If I pass thru this that men as that we got password if not
'we'll get into error handling routine
If cnn1.State = adStateClosed Then cnn1.Open
Screen.MousePointer = vbDefault
cnn1.Close
Set cnn1 = Nothing
' MsgBox "The Password Is: " & passw, vbInformation
xGetAccessPwd = passw
End If
Exit Function
EH:
If Err.Number = -2147467259 Or Err.Number = -2147217805 Then
s1 = Chr(Asc(s1) + 1)
GoToskip1
End If
If Err.Number <> -2147217843 Then 'Not valid password
MsgBox "error: " & Err.Number & ", " & Err.Description, vbCritical
Else
'Watch out this little trick, We will use last character
'from the masked password and
'try to find password, lets xor it
'(this works if password is 18 chars or less)
skip1:
If Asc(s1) = 255 Then
MsgBox "mail ivan@chameleon.co.yu", vbInformation
Exit Function
End If
If prviput Then
s1 = Right(passw, 1)
Else
If TrebaObavestiti Then
MsgBox "Password is more then 18 chars long." & _
" Must use brute force attack!", vbInformation
TrebaObavestiti = False
End If
'We will get here only if password is longer then 18
s1 = Chr(Asc(s1) + 1)
End If
passw = bckPass
If Len(passw) > 2 Then
For n = 1 To Len(passw)
If Right(passw, 1) = s1 Then
passw = Mid(passw, 1, Len(passw) - 1)
End If
Next
End If
priv = ""
For n = 1 To Len(passw)
If n Mod 2 <> 0 Then
s2 = Mid(passw, n, 1)
If (Asc(s1) Xor Asc(s2)) <> 0 Then
priv = priv & Chr(Asc(s1) Xor Asc(s2))
End If
Else
s2 = Mid(passw, n, 1)
priv = priv & s2
End If
Next
If priv = vbNullString Then
'MsgBox "No Password Found", vbInformation
xGetAccessPwd = ""
Else
'Lets try with this password if its ok.
'We are finished if not will do it 255 times more
If prviput Then
prviput = False
s1 = Asc(0)
End If
passw = priv
cnn1.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"DataSource=" & FileName & ";" & _
"Persist Security Info=False;" & _
"Jet OLEDB:Database Password=" & _
DuplirajApostrof(passw) & ";"
'Debug.Print s1, Asc(s1), passw
Resume
End If
End If
End Function
Public Function DuplirajApostrof(ByVal s As String) As String
'We have to be sure that we include all characters in brute force attack
Dim i As Long
i = InStr(1, s, """")
If i <> 0 Then
DuplirajApostrof = Left(s, i) & """" & DuplirajApostrof(Mid(s, i + 1, Len(s) - i + 1))
Else
DuplirajApostrof = s
End If
End Function
Utilisation:
Call setPasswordBase (xGetAccessPwd(URL_BASE))
Bon code ;)
++
Zlub
- Utiliser access
- Ado access - Meilleures réponses
- Access vba adodb - Meilleures réponses
- Comment utiliser access - Conseils pratiques -Visual Basic / VB.NET
- Programmeur access ✓ - Forum Visual Basic 6
- Access vba - Forum Visual Basic
- Access like ✓ - Forum SQL
- Stock access bde - Forum Delphi / Pascal