IdentifiantMot de passe
Mot de passe oublié ?Je m'inscris ! (gratuit)
logo
Sommaire > Gestion de la sécurité avec VBA > Avec DAO
        Changer le mot de passe d'un utilisateur
        Changer le mot de passe de l'utilisateur courant
        Compter le nombre d'utilisateurs
        Compter le nombre d'utilisateurs dans un groupe
        Compter le nombre de groupes
        Compter le nombre de groupe auxquels appartient un utilisateur
        Créer un nouveau groupe
        Créer un nouvel utilisateur
        Etablir la liste des groupes
        Etablir la liste des utilisateurs
        Lister les groupes d'un utilisateur
        Lister les utilisateurs d'un groupe
        Obtenir le nom de l'utilisateur courant
        Supprimer du système les utilisateurs appartenant à un groupe
        Supprimer les groupes ne possédant pas d'utilisateur
        Supprimer les utilisateurs appartenant à aucun groupe
        Supprimer un groupe
        Supprimer un utilisateur
        Tester l'existence d'un groupe
        Tester l'existence d'un utilisateur
        Tester l'existence d'un utilisateur à un groupe
        Vérifier qu'un utilisateur appartient au moins à un groupe
        Vérifier qu'un groupe contient des utilisateurs
rechercher
precedent    sommaire    suivant    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 NewPassword de l'objet User correspondant.

Important : Pour que ce code fonctionne vous devez ajouter la référence Microsoft DAO 3.X Object Library. 
Public Sub ChangerMotPasseUtilisateurDAO(strNomUtilisateur As String, _
    strAncienMotPasse As String, strNouveauMotPasse As String)
On Error GoTo err
Dim oWs As DAO.Workspace
Dim oUsr As DAO.User
Dim strMessageErreur As String
Set oWs = DBEngine.Workspaces(0)
Set oUsr = oWs.Users(strNomUtilisateur)
oUsr.NewPassword 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 : 
ChangerMotPasseUtilisateurDAO "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 ces codes fonctionnent, vous devez ajouter la référence Microsoft DAO 3.X Object Library.

Possibilité 1 : 
Public Sub ChangerMotPasseUtilisateurDAO(strNomUtilisateur As String, _
    strAncienMotPasse As String, strNouveauMotPasse As String)
On Error GoTo err
Dim oWs As DAO.Workspace
Dim oUsr As DAO.User
Dim strMessageErreur As String
Set oWs = DBEngine.Workspaces(0)
Set oUsr = oWs.Users(strNomUtilisateur)
oUsr.NewPassword 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 ChangerMotPasseUtilisateurCourantDAO _
    (strAncienMotPasse As String, strNouveauMotPasse As String)
ChangerMotPasseUtilisateurDAO DBEngine.Workspaces(0).UserName, _
    strAncienMotPasse, strNouveauMotPasse
End Sub
Possibilité 2 : 
Public Sub ChangerMotPasseUtilisateurCourantDAO(strAncienMotPasse As String, _
    strNouveauMotPasse As String)
On Error GoTo err
Dim oWs As DAO.Workspace
Dim oUsr As DAO.User
Dim strMessageErreur As String
Set oWs = DBEngine.Workspaces(0)
With oWs
    Set oUsr = .Users(.UserName)
End With
oUsr.NewPassword 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
Dans tous les cas, l'utilisation se fera ainsi : 
ChangerMotPasseUtilisateurCourantDAO "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.


Compter le nombre d'utilisateurs
auteur :
Pour compter le nombre d'utilisateurs au total, il suffit d'appeler la propriété Count de la collection Users de l'objet Workspace. Par exemple :

Important : Pour que ce code fonctionne, vous devez ajouter la référence Microsoft DAO 3.X Object Library. 
Msgbox DBEngine.Workspaces(0).Users.Count

Compter le nombre d'utilisateurs dans un groupe
auteur :
Pour compter le nombre d'utilisateurs dans un groupe, il suffit d'appeler la propriété Count de sa collection Users. Par exemple :

Important : Pour que ce code fonctionne, vous devez ajouter la référence Microsoft DAO 3.X Object Library. 
Public Function NombreUtilisateursDansGroupeDAO _
(strNomGroupe As String) As Integer

On Error GoTo err
Dim oWs As DAO.Workspace
'Récupère l'espace de travail
Set oWs = DBEngine.Workspaces(0)
'Retourne le nombre d'utilisateurs
NombreUtilisateursDansGroupeDAO = _
    oWs.Groups(strNomGroupe).Users.Count
err:
End Function
Exemple d'utilisation : 
MsgBox NombreUtilisateursDansGroupeDAO("Admins")

Compter le nombre de groupes
auteur :
Pour compter le nombre de groupes au total, il suffit d'appeler la propriété Count de la collection Groups de l'objet Workspace. Par exemple :

Important : Pour que ce code fonctionne, vous devez ajouter la référence Microsoft DAO 3.X Object Library. 
Msgbox DBEngine.Workspaces(0).Groups.Count

Compter le nombre de groupe auxquels appartient un utilisateur
auteur :
Pour compter le nombre de groupe auxquels appartient un utilisateur, il suffit d'appeler la propriété Count de sa collection Groups. Par exemple :

Important : Pour que ce code fonctionne, vous devez ajouter la référence Microsoft DAO 3.X Object Library. 
Public Function NombreGroupesUtilisateurDAO _
(strNomUtilisateur As String) As Integer

On Error GoTo err
Dim oWs As DAO.Workspace
'Récupère l'espace de travail
Set oWs = DBEngine.Workspaces(0)
'Retourne le nombre d'utilisateurs
NombreGroupesUtilisateurDAO = _
    oWs.Users(strNomUtilisateur).Groups.Count
err:
End Function
Exemple d'utilisation : 
MsgBox NombreGroupesUtilisateurDAO("Admin")

Créer un nouveau groupe
auteur :
Voici un exemple de création d'un nouveau groupe à l'aide de la méthode CreateGroup.

Important : Pour que ce codes fonctionne, vous devez ajouter la référence Microsoft DAO 3.X Object Library. 
Public Sub CreerGroupeDAO()
Dim oWs As DAO.Workspace
Dim strPid As String
Dim strNom As String

'Définit le nom
strNom = "Groupe_essai"
'Définit le PID (Identifiant unique)
strPid = Format(Now(), "yyyymmddhhnnss")
'Récupère l'espace de travail
Set oWs = DBEngine.Workspaces(0)
'Crée le nouveau groupe et l'ajoute à la collection Groups
With oWs
    .Groups.Append .CreateGroup("GrpTest", strPid)
End With
End Sub
Le PID est un identifiant unique du groupe, aussi, un moyen simple d'obtenir l'unicité de sa valeur est de sa baser sur l'horloge du système. C'est ce qui a été fait ici à l'aide de la fonction Format.


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 DAO 3.X Object Library. 
Public Sub CreerUtilisateurDAO()
Dim oWs As DAO.Workspace
Dim oUsr As DAO.User
Dim strPid As String
Dim strNom As String
Dim strPasse As String
'Définit le nom
strNom = "Utilisateur_essai"
'Définit le PID (Identifiant unique)
strPid = Format(Now(), "yyyymmddhhnnss")
'Définit le mot de passe
strPasse = "password"
'Récupère l'espace de travail
Set oWs = DBEngine.Workspaces(0)
'Crée le nouvel utilisateur
Set oUsr = oWs.CreateUser(strNom, strPid, strPasse)
'Ajoute l'utilisateur à la collection Users
oWs.Users.Append oUsr
'Ajoute l'utilisateur au groupe Admins
oWs.Groups("Admins").Users.Append oWs.CreateUser(strNom)
End Sub
Le PID est un identifiant unique de l'utilisateur, aussi, un moyen simple d'obtenir l'unicité de sa valeur est de sa baser sur l'horloge du système. C'est ce qui a été fait ici à l'aide de la fonction Format.


Etablir la liste des groupes
auteur :
Voici un exemple de procédure permettant de lister l'ensemble des groupes d'utilisateurs.

Important : Pour que ce code fonctionne, vous devez ajouter la référence Microsoft DAO 3.X Object Library. 
Public Sub ListerGroupesDAO()
Dim oWs As DAO.Workspace
Dim oGrp As DAO.Group
'Récupère l'espace de travail
Set oWs = DBEngine.Workspaces(0)
For Each oGrp In oWs.Groups
    MsgBox oGrp.Name
Next oGrp
End Sub

Etablir la liste des utilisateurs
auteur :
Voici un exemple de procédure permettant de lister l'ensemble des utilisateurs.

Important : Pour que ce code fonctionne, vous devez ajouter la référence Microsoft DAO 3.X Object Library. 
Public Sub ListerUtilisateursDAO()
Dim oWs As DAO.Workspace
Dim oUsr As DAO.User
'Récupère l'espace de travail
Set oWs = DBEngine.Workspaces(0)
'Parcours la liste des utilisateurs
For Each oUsr In oWs.Users
    MsgBox oUsr.Name
Next oUsr
End Sub

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 DAO 3.X Object Library. 
Public Sub ListerGroupeUtilisateurDAO(strNomUtilisateur As String)
On Error GoTo err
Dim oWs As DAO.Workspace
Dim oGrp As DAO.Group
Dim oUsr As DAO.User
Dim strMessageErreur As String
'Récupère l'espace de travail
Set oWs = DBEngine.Workspaces(0)
'Récupère le groupe
Set oUsr = oWs.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 : 
ListerGroupeUtilisateurDAO "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 DAO 3.X Object Library. 
Public Sub ListerUtilisateurDansGroupeDAO(strNomGroupe As String)
On Error GoTo err
Dim oWs As DAO.Workspace
Dim oGrp As DAO.Group
Dim oUsr As DAO.User
Dim strMessageErreur As String
'Récupère l'espace de travail
Set oWs = DBEngine.Workspaces(0)
'Récupère le groupe
Set oGrp = oWs.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 : 
ListerUtilisateurDansGroupeDAO "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é UserName de l'espace de travail.

Important : Pour que ce code fonctionne vous devez ajouter la référence Microsoft DAO 3.X Object Library. 
Public Function ObtenirNomUtilisateurDAO() As String
Dim oWs As DAO.Workspace
Set oWs = DBEngine.Workspaces(0)
ObtenirNomUtilisateurDAO = oWs.UserName
End Function
Exemple d'utilisation : 
MsgBox ObtenirNomUtilisateurDAO()

Supprimer du système les utilisateurs appartenant à un groupe
auteur :
Pour supprimer de la gestion de sécurité tous les utilisateurs qui appartienent à un groupe, il est nécessaire de parcourir la collection Users du groupe et d'appliquer la méthode Users.Delete de l'espace de travail en passant le nom de l'utilisateur en paramètre.

Important : Pour que ce code fonctionne, vous devez ajouter la référence Microsoft DAO 3.X Object Library. 
Public Sub SupprimerUtilisateursDeGroupeDAO _
   (strNomGroupe As String)
Dim oWs As DAO.Workspace
Dim oGrp As DAO.Group
Dim i As Integer
'Récupère l'espace de travail
Set oWs = DBEngine.Workspaces(0)
'Récupère le groupe
Set oGrp = oWs.Groups(strNomGroupe)
'Supprime les utilisateurs
For i = oGrp.Users.Count - 1 To 0 Step -1
    oWs.Users.Delete oGrp.Users(i)
Next i
End Sub

Supprimer les groupes ne possédant pas d'utilisateur
auteur :
Pour savoir si un groupe possède un ou plusieurs utilisateurs, il faut évaluer la propriété Count de sa collection Users. Il suffit alors de parcourir l'ensemble des groupes pour déterminer ceux à supprimer.

Important : Pour que ce code fonctionne, vous devez ajouter la référence Microsoft DAO 3.X Object Library. 
Public Sub SupprimerGroupesSansUtilisateurDAO()
Dim oWs As DAO.Workspace
Dim oGrp As DAO.Group
Dim i As Integer
'Récupère l'espace de travail
Set oWs = DBEngine.Workspaces(0)
'Parcours l'ensemble des groupes et supprime si besoin
For i = oWs.Groups.Count - 1 To 0 Step -1
    Set oGrp = oWs.Groups(i)
    If oGrp.Users.Count = 0 Then oWs.Groups.Delete oGrp.Name
Next i
End Sub

Supprimer les utilisateurs appartenant à aucun groupe
auteur :
Pour savoir si un utilisateur appartient à un ou plusieurs groupes, il faut évaluer la propriété Count de sa collection Groups. Il suffit alors de parcourir l'ensemble des utilisateurs (Collection Workspace.Users) pour déterminer ceux à supprimer.

Important : Pour que ce code fonctionne, vous devez ajouter la référence Microsoft DAO 3.X Object Library. 
Public Sub SupprimerUtilisateursSansGroupeDAO()
Dim oWs As DAO.Workspace
Dim oUsr As DAO.User
Dim i As Integer
'Récupère l'espace de travail
Set oWs = DBEngine.Workspaces(0)
'Parcours l'ensemble des utilisateurs et supprime si besoin
For i = oWs.Users.Count - 1 To 0 Step -1
    Set oUsr = oWs.Users(i)
    If oUsr.Groups.Count = 0 Then oWs.Users.Delete oGrp.Name
Next i
End Sub

Supprimer un groupe
auteur :
Voici un exemple de création de suppression de groupe. Il suffit d'appeler la méthode delete de la collection Workspace.Groups.

Important : Pour que ce code fonctionne, vous devez ajouter la référence Microsoft DAO 3.X Object Library. 
Public Sub SupprimerGroupeDAO _
    (strNomGroupe As String)
On Error GoTo err
Dim oWs As DAO.Workspace
Dim strMessage As String
'Récupère l'espace de travail
Set oWs = DBEngine.Workspaces(0)
'Supprime le groupe
oWs.Groups.Delete strNomGroupe

fin:
Exit Sub


err:
'Gestion des erreurs
Select Case err.Number
    Case 3265
        strMessage = "Groupe inexistant"
    Case Else
        strMessage = "Erreur inconnue"
End Select
MsgBox strMessage, vbCritical, "Erreur"
Resume fin
End Sub
Le nom du groupe est à passer en paramètre de la fonction.


Supprimer un utilisateur
auteur :
Voici un exemple de création de suppression d'un utilisateur.

Important : Pour que ce code fonctionne, vous devez ajouter la référence Microsoft DAO 3.X Object Library. 
Public Sub SupprimerUtilisateurDAO _
  (strNomUtilisateur As String)
On Error GoTo err
Dim oWs As DAO.Workspace
Dim strMessage As String
'Récupère l'espace de travail
Set oWs = DBEngine.Workspaces(0)
'Supprime l'utilisateur
oWs.Users.Delete strNomUtilisateur

fin:
Exit Sub


err:
'Gestion des erreurs
Select Case err.Number
    Case 3265
        strMessage = "Utilisateur inexistant"
    Case Else
        strMessage = "Erreur inconnue"
End Select
MsgBox strMessage, vbCritical, "Erreur"
Resume fin
End Sub
Le nom du groupe est à passer en paramètre de la fonction.


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 DAO 3.X Object Library. 
Public Function TesterExistenceGroupeDAO _
  (strNomGroupe As String) As Boolean
On Error GoTo err
Dim oWs As DAO.Workspace
Dim oGrp As DAO.Group
'Récupère l'espace de travail
Set oWs = DBEngine.Workspaces(0)
'Tente d'accéder à l'utilisateur
Set oGrp = oWs.Groups(strNomGroupe)
TesterExistenceGroupeDAO = True
err:
End Function
Exemple d'utilisation : 
MsgBox TesterExistenceGroupeDAO("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 DAO 3.X Object Library. 
Public Function TesterExistenceUtilisateurDAO _
(strNomUtilisateur As String) As Boolean
On Error GoTo err
Dim oWs As DAO.Workspace
Dim oUsr As DAO.User
'Récupère l'espace de travail
Set oWs = DBEngine.Workspaces(0)
'Tente d'accéder à l'utilisateur
Set oUsr = oWs.Users(strNomUtilisateur)
TesterExistenceUtilisateurDAO = True
err:
End Function
Exemple d'utilisation : 
MsgBox TesterExistenceUtilisateurDAO("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 DAO 3.X Object Library. 
Public Function TesterUtilisateurDansGroupeDAO _
    (strNomUtilisateur As String, _
    strNomGroupe As String) As Boolean

On Error GoTo err
Dim oWs As DAO.Workspace
Dim oUsr As DAO.User

'Récupère l'espace de travail
Set oWs = DBEngine.Workspaces(0)
'Tente d'accéder à l'utilisateur depuis le groupe
Set oUsr = oWs.Groups(strNomGroupe).Users(strNomUtilisateur)
'Retourne True
TesterUtilisateurDansGroupeDAO = True
err:
End Function
La fonction retourne Vrai si l'utilisateur strNomUtilisateur appartient au groupe nommé strNomGroupe.

Exemple d'utilisation : 
MsgBox TesterUtilisateurDansGroupeDAO("Utilisateur1000", "Admins")

Vérifier qu'un utilisateur appartient au moins à un groupe
auteur :
Cette fonction permet de savoir si un utilisateur appartient au moins à un groupe.

Important : Pour que ce code fonctionne, vous devez ajouter la référence Microsoft DAO 3.X Object Library. 
Public Function EstUtilisateurSansGroupeDAO _
    (strNomUtilisateur As String) As Boolean
Dim oWs As DAO.Workspace
'Récupère l'espace de travail
Set oWs = DBEngine.Workspaces(0)
EstGroupeVide = Not oWs.Users(strNomUtilisateur).Groups.Count = 0
End Function
Exemple d'utilisation : 
MsgBox EstUtilisateurSansGroupeDAO("Admin")

Vérifier qu'un groupe contient des utilisateurs
auteur :
Cette fonction permet de savoir si un groupe ne contient pas d'utilisateur.

Important : Pour que ce code fonctionne, vous devez ajouter la référence Microsoft DAO 3.X Object Library. 
Public Function EstGroupeVideDAO _
    (strNomGroupe As String) As Boolean
Dim oWs As DAO.Workspace
'Récupère l'espace de travail
Set oWs = DBEngine.Workspaces(0)
EstGroupeVide = Not oWs.Groups(strNomGroupe).Users.Count = 0
End Function
Exemple d'utilisation : 
MsgBox EstGroupeVideDAO("Admins")
rechercher
precedent    sommaire    suivant    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.