IdentifiantMot de passe
Mot de passe oublié ?Je m'inscris ! (gratuit)
logo
Sommaire > Gestion de la sécurité avec VBA > Avec ADO
        Changer le mot de passe d'un utilisateur
        Changer le mot de passe de l'utilisateur courant
        Créer un nouveau groupe
        Créer un nouvel utilisateur
        Lister les groupes d'un utilisateur
        Lister les utilisateurs d'un groupe
        Obtenir le nom de l'utilisateur courant
        Tester l'existence d'un groupe
        Tester l'existence d'un utilisateur
        Tester l'existence d'un utilisateur à un groupe
rechercher
precedent    sommaire       telecharger

Changer le mot de passe d'un utilisateur
auteur :
Pour modifier le mot de passe d'un utilisateur il faut appeler la méthode ChangePassword de l'objet User correspondant.

Important : Pour que ce code fonctionne vous devez ajouter la référence Microsoft ADO Ext 2.X for DDL and Security. 
Public Sub ChangerMotPasseUtilisateurADO(strNomUtilisateur As String, _
    strAncienMotPasse As String, strNouveauMotPasse As String)
On Error GoTo err
Dim oCat As ADOX.Catalog
Dim oUsr As ADOX.User
Dim strMessageErreur As String
'Instancie un nouvel objet catalogue
Set oCat = New ADOX.Catalog
oCat.ActiveConnection = CurrentProject.Connection
Set oUsr = oCat.Users(strNomUtilisateur)
oUsr.ChangePassword strAncienMotPasse, strNouveauMotPasse

fin:
Exit Sub

err:
Select Case err.Number
    Case 3265
        strMessageErreur = "Cet utilisateur n'existe pas"
    Case Else
        strMessageErreur = "Mot de passe incorrect"
End Select
MsgBox strMessageErreur, vbCritical, "Erreur"
Resume fin
End Sub
Exemple d'utilisation : 
ChangerMotPasseUtilisateurADO "Utilisateur_toto", "ancien", "nouveau"

Changer le mot de passe de l'utilisateur courant
auteur :
Pour modifier le mot de passe de l'utilisateur courant il faut appeler la méthode NewPassword de l'objet User correspondant.

Deux possiblités :

  • Utiliser la méthode permettant de changer le mot de passe de n'importe quel utilisateur en lui passant comme paramètre le nom de l'utilisateur courant
  • Tout réécrire

Important : Pour que ce code fonctionne vous devez ajouter la référence Microsoft ADO Ext 2.X for DDL and Security.

Possibilité 1 : 
Public Sub ChangerMotPasseUtilisateurADO(strNomUtilisateur As String, _
    strAncienMotPasse As String, strNouveauMotPasse As String)
On Error GoTo err
Dim oCat As ADOX.Catalog
Dim oUsr As ADOX.User
Dim strMessageErreur As String
'Instancie un nouvel objet catalogue
Set oCat = New ADOX.Catalog
oCat.ActiveConnection = CurrentProject.Connection
Set oUsr = oCat.Users(strNomUtilisateur)
oUsr.ChangePassword strAncienMotPasse, strNouveauMotPasse

fin:
Exit Sub

err:
Select Case err.Number
    Case 3265
        strMessageErreur = "Cet utilisateur n'existe pas"
    Case Else
        strMessageErreur = "Mot de passe incorrect"
End Select
MsgBox strMessageErreur, vbCritical, "Erreur"
Resume fin
End Sub

Public Sub ChangerMotPasseUtilisateurCourantADO _
    (strAncien As String, strNouveau As String)
ChangerMotPasseUtilisateurADO CurrentProject.Connection.Properties("User Name"), _
    strAncien, strNouveau
End Sub
Possibilité 2 : 
Public Sub ChangerMotPasseUtilisateurCourantADO _
    (strAncienMotPasse As String, strNouveauMotPasse As String)
On Error GoTo err
Dim oCat As ADOX.Catalog
Dim oUsr As ADOX.User
Dim oCnx As ADODB.Connection
Dim strMessageErreur As String
'Récupère la connexion du projet
Set oCnx = CurrentProject.Connection
'Instancie un nouvel objet catalogue
Set oCat = New ADOX.Catalog
oCat.ActiveConnection = oCnx
'Instancie l'objet User correspondant
Set oUsr = oCat.Users(oCnx.Properties("User Name").Value)
'Change le mot de passe
oUsr.ChangePassword strAncienMotPasse, strNouveauMotPasse

fin:
Exit Sub

err:
MsgBox "Mot de passe incorrect", vbCritical, "Erreur"
Resume fin
End Sub
Dans tous les cas, l'utilisation se fera ainsi : 
ChangerMotPasseUtilisateurCourantADO "ancien", "nouveau"
L'avantage de la première méthode est d'être plus générique et de permettre de modifier le mot de passe d'autres utilisateurs, toutefois, si vous n'avez pas ce besoin, la seconde sera suffisante.


Créer un nouveau groupe
auteur :
Voici un exemple de création d'un nouveau groupe à l'aide de la méthode Append Nom du groupe de la collection Groups.

Important : Pour que ce code fonctionne vous devez ajouter la référence Microsoft ADO Ext 2.X for DDL and Security. 
Public Sub CreerGroupeADO()
Dim oCat As ADOX.Catalog

'Instancie un nouvel objet catalogue
Set oCat = New ADOX.Catalog
Set oCat.ActiveConnection = CurrentProject.Connection

'Crée le nouveau groupe et l'ajoute à la collection Groups
With oCat
    .Groups.Append "Groupe_Test"
End With
End Sub

Créer un nouvel utilisateur
auteur :
Voici un exemple de création d'un nouvel utilisateur ainsi que l'assignation de ce dernier à un groupe.

Important : Pour que ce code fonctionne vous devez ajouter la référence Microsoft ADO Ext 2.X for DDL and Security. 
Public Sub CreerUtilisateurADO()
Dim oCat As ADOX.Catalog
Dim oUsr As ADOX.User
Dim strNom As String
Dim strPasse As String
'Définit le nom
strNom = "Utilisateur1000"
'Définit le mot de passe
strPasse = "password"
'Instancie un nouvel objet catalogue
Set oCat = New ADOX.Catalog
With oCat
    Set .ActiveConnection = CurrentProject.Connection
    'Crée le nouvel utilisateur
    .Users.Append strNom, strPasse
    'Ajoute l'utilisateur au groupe Admins
    .Groups("Admins").Users.Append strNom
End With
End Sub
L'utilisateur est d'abord créé puis ajouté au groupe administrateur.


Lister les groupes d'un utilisateur
auteur :
Voici un exmple de procédure permettant d'afficher les noms des groupes auxquels appartient l'utilisateur passé en paramètre.

Important : Pour que ce code fonctionne vous devez ajouter la référence Microsoft ADO Ext 2.X for DDL and Security. 
Public Sub ListerGroupeUtilisateurADO(strNomUtilisateur As String)
On Error GoTo err
Dim oCat As ADOX.Catalog
Dim oGrp As ADOX.Group
Dim oUsr As ADOX.User
Dim strMessageErreur as String
'Instancie un nouvel objet Catalogue
Set oCat = New ADOX.Catalog
Set oCat.ActiveConnection = CurrentProject.Connection
'Récupère l'utilisateur
Set oUsr = oCat.Users(strNomUtilisateur)
'Parcours les utilisateurs du groupe
For Each oGrp In oUsr.Groups
    'Affiche leur nom
    MsgBox oGrp.Name
Next oGrp

fin:
Exit Sub

err:
Select Case err.Number
    Case 3265
        strMessageErreur = "Cet utilisateur n'existe pas"
    Case Else
        strMessageErreur = "Erreur inconnue"
End Select
MsgBox strMessageErreur, vbCritical, "Erreur"
Resume fin
End Sub
Exemple d'utilisation : 
ListerGroupeUtilisateurADO "Utilisateur1000"

Lister les utilisateurs d'un groupe
auteur :
Voici un exmple de procédure permettant d'afficher les noms des utilisateurs appartenant au groupe passé en paramètre.

Important : Pour que ce code fonctionne vous devez ajouter la référence Microsoft ADO Ext 2.X for DDL and Security. 
Public Sub ListerUtilisateurDansGroupeADO(strNomGroupe As String)
On Error GoTo err
Dim oCat As ADOX.Catalog
Dim oGrp As ADOX.Group
Dim oUsr As ADOX.User
Dim strMessageErreur as String
'Instancie un nouvel objet Catalogue
Set oCat = New ADOX.Catalog
Set oCat.ActiveConnection = CurrentProject.Connection
'Récupère le groupe
Set oGrp = oCat.Groups(strNomGroupe)
'Parcours les utilisateurs du groupe
For Each oUsr In oGrp.Users
    'Affiche leur nom
    MsgBox oUsr.Name
Next oUsr

fin:
Exit Sub

err:
Select Case err.Number
    Case 3265
        strMessageErreur = "Ce groupe n'existe pas"
    Case Else
        strMessageErreur = "Erreur inconnue"
End Select
MsgBox strMessageErreur, vbCritical, "Erreur"
Resume fin
End Sub
Exemple d'utilisation : 
ListerUtilisateurDansGroupeADO "Admins"

Obtenir le nom de l'utilisateur courant
auteur :
Pour obtenir le nom de l'utilisateur courant (celui qui a ouvert la base de données), il faut interroger la propriété User Name de la connexion à la base de données. Cette propriété est disponible depuis la collection Propertiesde l'objet Connection.

Important : Pour que ce code fonctionne vous devez ajouter la référence Microsoft ADO Ext 2.X for DDL and Security. 
Public Function ObtenirNomUtilisateurADO() As String
Dim oCnx As ADODB.Connection
Set oCnx = CurrentProject.Connection
ObtenirNomUtilisateurADO = oCnx.Properties("User Name")
End Function
Exemple d'utilisation : 
MsgBox ObtenirNomUtilisateurADO()

Tester l'existence d'un groupe
auteur :
Le plus simple pour vérifier si un groupe existe ou pas est de tenter d'y accéder et de gérer l'erreur en cas d'echec.

Important : Pour que ce code fonctionne vous devez ajouter la référence Microsoft ADO Ext 2.X for DDL and Security. 
Public Function TesterExistenceGroupeADO _
    (strNomGroupe As String) As Boolean
On Error GoTo err
Dim oCat As ADOX.Catalog
Dim oGrp As ADOX.Group
'Instancie un nouvel objet catalogue
Set oCat = New ADOX.Catalog
oCat.ActiveConnection = CurrentProject.Connection
Set oGrp = oCat.Groups(strNomGroupe)
TesterExistenceGroupeADO = True
err:
End Function
Exemple d'utilisation : 
MsgBox TesterExistenceGroupADO("Admins")

Tester l'existence d'un utilisateur
auteur :
Le plus simple pour vérifier si un utilisateur existe ou pas est de tenter d'y accéder et de gérer l'erreur en cas d'echec.

Important : Pour que ce code fonctionne vous devez ajouter la référence Microsoft ADO Ext 2.X for DDL and Security. 
Public Function TesterExistenceUtilisateurADO _
    (strNomUtilisateur As String) As Boolean
On Error GoTo err
Dim oCat As ADOX.Catalog
Dim oUsr As ADOX.User
'Instancie un nouvel objet catalogue
Set oCat = New ADOX.Catalog
oCat.ActiveConnection = CurrentProject.Connection
Set oUsr = oCat.Users(strNomUtilisateur)
TesterExistenceUtilisateurADO = True
err:
End Function
Exemple d'utilisation : 
MsgBox TesterExistenceUtilisateurADO("Admin")

Tester l'existence d'un utilisateur à un groupe
auteur :
Le plus simple pour vérifier si un utilisateur appartient à un groupe est de tenter d'accéder à celui-ci depuis l'objet Group recherché.

Important : Pour que ce code fonctionne vous devez ajouter la référence Microsoft ADO Ext 2.X for DDL and Security. 
Public Function TesterUtilisateurDansGroupeADO _
    (strNomUtilisateur As String, _
    strNomGroupe As String) As Boolean

On Error GoTo err
Dim oCat As ADOX.Catalog
Dim oUsr As ADOX.User

'Instancie un nouvel objet catalogue
Set oCat = New ADOX.Catalog
oCat.ActiveConnection = CurrentProject.Connection
'Tente d'accéder à l'utilisateur depuis le groupe
Set oUsr = oCat.Groups(strNomGroupe).Users(strNomUtilisateur)
'Retourne True
TesterUtilisateurDansGroupeADO = True
err:
End Function
La fonction retourne Vrai si l'utilisateur strNomUtilisateur appartient au groupe nommé strNomGroupe.

Exemple d'utilisation : 
MsgBox TesterUtilisateurDansGroupeADO("Utilisateur1000", "Admins")
rechercher
precedent    sommaire       telecharger

Consultez les autres F.A.Q's

Valid XHTML 1.1!Valid CSS!

Copyright © 2005 WARIN Christophe. Aucune reproduction, même partielle, ne peut être faite de ce site ni de l'ensemble de son contenu : textes, documents, images, etc. sans l'autorisation expresse de l'auteur. Sinon vous encourez selon la loi jusqu'à trois ans de prison et jusqu'à 300 000 € de dommages et intérêts.