Sujet Précédent Sujet Suivant

Pb de droits avec AddNew en Access + VBA

Résolu
hjanod Messages postés 2 Date d'inscription samedi 4 novembre 2000 Statut Membre Dernière intervention 7 mars 2006 - 6 mars 2006 à 17:30
Tuning Max Messages postés 314 Date d'inscription mercredi 15 juin 2005 Statut Membre Dernière intervention 31 août 2006 - 7 mars 2006 à 16:51
Bonjour,

Ma base A.mdb a ses tables définies dans une base B.mdb (notion de tables liées).
La base A.mdb contient toute la partie interface, la base B.mdb contient les données
J'ai par ailleurs un fichier Sécurité.mdw qui contient la liste des utilisateurs et groupes permettant d'accéder à la base.
Pour info, je lance ma base par le raccourci [...]\msaccess.exe a.mdb /WRKGRP sécurité.mdw, ceci arrivant donc à une invite de logging/password

Dans la base B.mdb, j'ai une table "Logging" pour savoir qui est connecté sur la base. Dans la base A.mdb, j'ai défini la table "logging" comme liée à Logging de B.mdb.

Dans la base A, j'ai défini à la commande OPEN du premier formulaire un appel à une macro, qui est :

Private Sub Form_Open(Cancel As Integer)
' Lancé à l'ouverture de la fenêtre
Dim MaTable As Recordset
Set MaTable = CurrentDb.OpenRecordset("Logging", dbOpenDynaset)
MaTable.AddNew
MaTable![User Connecté] = Environ("UserName")
MaTable![ordinateur] = Environ("ComputerName")
MaTable![date connexion] = Now()
MaTable.Update
MaTable.Bookmark = MaTable.LastModified
MaTable.Close
End Sub

J'ai un utilisateur "x", qui est dans un groupe "Utilisateurs" et dans un groupe "Lecture seule".
Toutes les tables, formulaires, reports, requêtes, ... ont les propriétés de màj interdites aux membres de "Lecture seule"

Pour permettre l'insertion d'un enregistrement dans la table "Logging", j'ai (dans les autorisations d'accès) autorisé les groupes "Utilisateurs" et "Lecture seule" à administrer la table "Logging".
Malgré cela, lorsque je me connecte avec le user "x", ma macro plante à la ligne "MaTable.addnew" sur le message d'erreur suivant :
"Erreur d'exécution 3033"
Pour essayer de corriger, j'ai modifié les autorisations d'accès, et pour l'utilisateur "x", j'ai ajouté aussi "Administrer" sur la table "Logging".
Toujours le même message d'erreur.
Dernier essai, j'ai déclaré "x" dans le groupe "Administrateurs". Là, impeccable, ça marche, mais bon, "x" a alors accès en màj sur toute la base !

Auriez-vous une idée pour m'aider à résoudre ce pb, je ne souhaite pas que "x" soit administrateur ...
Merci d'avance

4 réponses

Réponse 1 / 4
Tuning Max Messages postés 314 Date d'inscription mercredi 15 juin 2005 Statut Membre Dernière intervention 31 août 2006 1
7 mars 2006 à 16:18
pour ton deuxième problème, je te conseillerais d'effectuer la mise à jour de ta table par code vba avec les droits d'un compte spécifique de type admin. Tu creer une deuxième connection avec ce compte tu met a jour ta table et tu referme le tout car Access n'aime pas trop travailler comme ça
Sinon pour le formulaire , ça me semble difficile, tu as déjà l'image je vais copier ci-dessous le code qui lui est rataché ainsi que la fonction que j'ai récupérer je ne sais plus où et que j'ai adapté à mes besoins.

Private Sub Form_Load()
On Error GoTo Err_Form_Load
Dim dbWorkspace As Workspace, dbDatabase As Database, dbNameUser As dao.User, dbNameGrpDispo As dao.Group, txtConnected As String
Dim dbNameGrpAffect As dao.Group, Utilisateur As dao.User, UserName As String, groupname As Group
'***** Calcul & affichage du nombre d’utilisateurs
Me.NbreUserTxt.Value = DBEngine.Workspaces(0).Users.Count
Me.CmbUsersListe.Value = ""
Me.CmbUsersListe.RowSource = ""
'***** Insertion dans la ComboListe de tous les nom d'utilisateurs pouvant se connecter
For Each dbNameUser In DBEngine.Workspaces(0).Users
If IsNothing(Me.CmbUsersListe.RowSource) Then
Me.CmbUsersListe.RowSourceType = "Liste valeurs"
Me.CmbUsersListe.RowSource = dbNameUser.Name
Else:
Me.CmbUsersListe.RowSource = Me.CmbUsersListe.RowSource & ";" & dbNameUser.Name
End If
Next
Me.CmbUsersListe.Value = CurrentUser
'***** Insertion dans la GrpListeDispo de tous les nom de groupe
Me.GrpListeDispo = Nothing
Me.GrpListeDispo.RowSource = ""
For Each dbNameGrpDispo In DBEngine.Workspaces(0).Groups
If IsNothing(Me.GrpListeDispo.RowSource) Then
Me.GrpListeDispo.RowSourceType = "Liste valeurs"
Me.GrpListeDispo.RowSource = dbNameGrpDispo.Name
Else:
Me.GrpListeDispo.RowSource = Me.GrpListeDispo.RowSource & ";" & dbNameGrpDispo.Name
End If
Next
'***** Insertion dans la GrpListeAffect de tous les nom de groupe de la personnes sélectionnée
Me.GrpListeAffect = Nothing
Me.GrpListeAffect.RowSource = ""
Set dbWorkspace = DBEngine.Workspaces(0)
Set Utilisateur = dbWorkspace.Users(dbWorkspace.UserName)

For Each groupname In Utilisateur.Groups
If IsNothing(Me.GrpListeAffect.RowSource) Then
Me.GrpListeAffect.RowSourceType = "Liste valeurs"
Me.GrpListeAffect.RowSource = groupname.Name
Else:
Me.GrpListeAffect.RowSource = Me.GrpListeAffect.RowSource & ";" & groupname.Name
End If
Next groupname
Set dbWorkspace = Nothing
'***** Insetion dans la zonne de liste des utilisateurs actuellement connectés
Me.UsersListeConnect.RowSourceType = "Liste valeurs"
Me.UsersListeConnect.RowSource = Who_Is ' Appel de la fonction publique de recherche des personnes et ordinateurs connecté
Me.UsersListeConnect = Nothing


Exit_Form_Load:
Exit Sub


Err_Form_Load:
MsgBox err.Description
Resume Exit_Form_Load
End Sub

Public Function Who_Is() As String
' -- retourne une liste séparée par des points virgules indiquant le nom de l'ordinateur ainsi que
' -- l'utilisateur connecté à la base.
On Error GoTo Err_Who_Is
Dim Mon_LDB As Integer, i As Integer
Dim Mon_Chemin As String
Dim Mon_Log As String, Ma_Connexion As String
Dim Nom_PC As String, Nom_Utilisateur As String
Dim Utilisateur As Un_Connecté
Mon_Chemin = CurrentDb.Name
CurrentDb.Close
' --Aller chercher le LDB
Mon_Chemin = Left(Mon_Chemin, InStr(1, Mon_Chemin, ".")) + "LDB"
Mon_LDB = FreeFile
' --Ouvrir le LDB
Open Mon_Chemin For Binary Access Read Shared As Mon_LDB
' -- Lire le LDB
Do While Not EOF(Mon_LDB)
' -- Chaque enregistrement lu est placé dans la variable utilisateur pour y être traité.
Get Mon_LDB, , Utilisateur
With Utilisateur
i = 1
Nom_PC = ""
' -- nom du PC
While .PC(i) <> 0
Nom_PC = Nom_PC & Chr(.PC(i))
i = i + 1
Wend
i = 1
Nom_Utilisateur = ""
' -- nom de l'utilisateur
While .User(i) <> 0
Nom_Utilisateur = Nom_Utilisateur & Chr(.User(i))
i = i + 1
Wend
End With
Mon_Log = Nom_PC & " | " & Nom_Utilisateur
If InStr(Ma_Connexion, Mon_Log) = 0 Then
Ma_Connexion = Ma_Connexion & Mon_Log & ";"
End If
Loop
Close Mon_LDB
' --Who_Is contient la liste des utilisateurs
Who_Is = Ma_Connexion
Exit_Who_Is:
Exit Function
Err_Who_Is:
MsgBox err.Number & vbCrLf & err.Description, vbInformation, "Erreur"
Close Mon_LDB
Resume Exit_Who_Is
End Function
3
Réponse 2 / 4
Tuning Max Messages postés 314 Date d'inscription mercredi 15 juin 2005 Statut Membre Dernière intervention 31 août 2006 1
7 mars 2006 à 15:16
En fait je ne comprend pas pourquoi tu créer tes table login. Tu as manifestement déjà une bonne connaissance de la sécurité sur Access (enfin si ont peut appeler ça de la sécurité :-)) puisque tu as protégé ta base au niveau utilisateur, avec un groupe de travail mdw.
En se qui me concerne, il y a quelques temps, j'avais développé une petite appli sécurisé du même type que la tienne, et pour l'administration, j'utilisais un formulaire sur lequel j'avais un datalist qui scanné le fichier "ldb" pour afficher les personnes connecté et leur machine.
0
Réponse 3 / 4
hjanod Messages postés 2 Date d'inscription samedi 4 novembre 2000 Statut Membre Dernière intervention 7 mars 2006
7 mars 2006 à 15:52
Merci de ta réponse.
Saurais-tu me faire parvenir ce formulaire et cette datalist qui scanne le fichier ldb ?
Car ma table logging est d'une part pour savoir qui est connecté actuellement, mais aussi pour stocker qui a accédé à ma base et quand.
Et pour ce 2ème point, j'ai toujours mon pb de droits ...
Merci d'avance pour ta réponse.
0
Réponse 4 / 4
Tuning Max Messages postés 314 Date d'inscription mercredi 15 juin 2005 Statut Membre Dernière intervention 31 août 2006 1
7 mars 2006 à 16:51
J'allais oublier le code des boutons!

Code du boutons Ajouter un utilisateur :
Private Sub cmdCreatUsers_Click()
On Error GoTo Err_cmdCreatUsers_Click
Dim strUser As String, strpid As String, strinitialpwd As String, wsp As Workspace, db As Database
Dim Utilisateur As User, strGroup As String
'***** Création d'un nouvel utilisateur dans le WorkSpace courrant
'**** Définition des variables
strUser = vbNullString
strpid = vbNullString
While strUser = vbNullString
strUser = InputBox("Veuillez indiquer le login!", "Login")
Wend
While strpid = vbNullString
strpid = InputBox("Veuillez indiquer la clé!", "Login")
Wend
strinitialpwd = ""
strGroup = "Users"
'**** Définition du workSpace courrant
Set wsp = DBEngine.Workspaces(0)
'**** Création de l'utilisateur saisie dans le workspace
Set Utilisateur = wsp.CreateUser(strUser, strpid, strinitialpwd)
wsp.Users.Append Utilisateur
'**** Affectation de l'utilisateur à un groupe de reference
Utilisateur.Groups.Append wsp.CreateGroup(strgroup)
'**** Déchargement de la mémoire
Set wsp = Nothing
Set Utilisateur = Nothing
strUser = ""
strpid = ""
strinitialpwd = ""
strGroup = ""
Me.Requery


Exit_cmdCreatUsers_Click:
Exit Sub


Err_cmdCreatUsers_Click:
MsgBox err.Description
Resume Exit_cmdCreatUsers_Click
End Sub

Code du bouton Supprimer :
Private Sub CmdSuppressUsers_Click()
On Error GoTo Err_CmdSuppressUsers_Click
Dim strUser As String, strpid As String, strinitialpwd As String, wsp As Workspace, db As Database
Dim Utilisateur As User, strGroup As String, formName As String
Dim dbWorkspace As Workspace, dbDatabase As Database, dbNameUser As User


strUser = Me.CmbUsersListe
formName = Me.Name If strUser "Creator" Or strUser "Engine" Or strUser = "admin" Then
MsgBox "Vous ne pouvez pas supprimer les comptes system", vbCritical, "Attention"
Exit Sub
Else:
intRtn = MsgBox(" Etes vous sûr de vouloir supprimer cet utilisateur? " & _
" Cliquez sur Oui pour le supprimer définitivement " & _
"sur Non pour revenir au formulaire", vbExclamation + vbYesNo, "Microsoft Press")
Select Case intRtn
' ******* Cancel
Case vbNo
Me.Visible = True
Exit Sub
' ******* Repond Yes -
Case vbYes
DBEngine.Workspaces(0).Users.Delete (strUser)
End Select
End If
DoCmd.Close acForm, formName
DoCmd.OpenForm formName, acNormal, , , acFormEdit, acWindowNormal


Exit_CmdSuppressUsers_Click:
Exit Sub


Err_CmdSuppressUsers_Click:
MsgBox err.Description
Resume Exit_CmdSuppressUsers_Click
End Sub

Code du bouton qui enlève l'utilisateur d'un groupe :
Private Sub CmdSuppGroup_Click()
On Error GoTo Err_CmdSuppGroup_Click
Dim strUser As String, strGroup As String, u As User, GName

If Not IsNothing(Me.CmbUsersListe) And Not IsNothing(Me.GrpListeAffect) Then
'**** Suppression de l'utilisateur dans un groupe de reference
strUser = Me.CmbUsersListe.Value
strGroup = Me.GrpListeAffect.Value
Set u = DBEngine.Workspaces(0).Users(strUser)
On Error Resume Next
GName = u(strGroup).Name ' séparez pour la gestion d'erreur
If GName = strGroup Then
u.Groups.Delete strGroup
Else
Debug.Print "Aucun utilisateur <" & strUser & "> dans le groupe <" & strGroup & ">"
End If


'***** Insertion dans la GrpListeAffect de tous les nom de groupe de la personnes sélectionnée
Me.GrpListeAffect = Nothing
Me.GrpListeAffect.RowSource = ""

For Each GName In u.Groups
If IsNothing(Me.GrpListeAffect.RowSource) Then
Me.GrpListeAffect.RowSourceType = "Liste valeurs"
Me.GrpListeAffect.RowSource = GName.Name
Else:
Me.GrpListeAffect.RowSource = Me.GrpListeAffect.RowSource & ";" & GName.Name
End If
Next GName
End If

Exit_CmdSuppGroup_Click:
Exit Sub


Err_CmdSuppGroup_Click:
If err.Number = 3032 Then
MsgBox "Le groupe sélectionné est déjà affecté à cet utilisateur"
Else:
MsgBox err.Description & err.Number
End If
Resume Exit_CmdSuppGroup_Click
End Sub

Code du bouton qui ajoute l'utilisateur à un groupe :
Private Sub CmdAddGroup_Click()
On Error GoTo Err_CmdAddGroup_Click
Dim dbWorkspace As Workspace, Utilisateur As User, strGroup As String, groupname As Group, strUser As String


'**** Affectation de l'utilisateur à un groupe de reference
Set dbWorkspace = DBEngine.Workspaces(0)
strUser = Me.CmbUsersListe
strGroup = Me.GrpListeDispo
Set Utilisateur = DBEngine.Workspaces(0).Users(strUser)
With dbWorkspace
Utilisateur.Groups.Append dbWorkspace.CreateGroup(strGroup)
End With
'***** Insertion dans la GrpListeAffect de tous les nom de groupe de la personnes sélectionnée
Me.GrpListeAffect = Nothing
Me.GrpListeAffect.RowSource = ""

For Each groupname In Utilisateur.Groups
If IsNothing(Me.GrpListeAffect.RowSource) Then
Me.GrpListeAffect.RowSourceType = "Liste valeurs"
Me.GrpListeAffect.RowSource = groupname.Name
Else:
Me.GrpListeAffect.RowSource = Me.GrpListeAffect.RowSource & ";" & groupname.Name
End If
Next groupname

Set dbWorkspace = Nothing
Exit_CmdAddGroup_Click:
Exit Sub


Err_CmdAddGroup_Click:
If err.Number = 3032 Then
MsgBox "Le groupe sélectionné est déjà affecté à cet utilisateur"
Else:
MsgBox err.Description & err.Number
End If
Resume Exit_CmdAddGroup_Click
End Sub

Code qui supprime le mot de passe d'un utilisateur :
Private Sub CmdClearPassword_Click()
On Error GoTo Err_CmdClearPassword_Click
Dim strUser As String, strpid As String, strinitialpwd As String, wsp As Workspace, db As Database
Dim Utilisateur As User, strGroup As String, strOldPwd As String, strNewPwd As String


strUser = Me.CmbUsersListe
strNewPwd = "" If strUser "Creator" Or strUser "Engine" Or strUser = "admin" Then
MsgBox "Vous ne pouvez pas modifier les comptes system", vbCritical, "Attention"
Exit Sub
Else:
Set Utilisateur = DBEngine.Workspaces(0).Users(strUser)
Utilisateur.NewPassword strOldPwd, strNewPwd
End If

Exit_CmdClearPassword_Click:
Exit Sub


Err_CmdClearPassword_Click:
MsgBox err.Description
Resume Exit_CmdClearPassword_Click
End Sub
0

Discussions similaires

Comment fonctionne la fonction FormulaR1C1
cs_razmokets -
wape -

2 réponses
fonction modulo en VBA
krisprolss -
Benouille -

2 réponses
Dernière cellule non vide d'une colonne
cs_falafala -
Luigi13013 -

5 réponses
A quoi sert la fonction Set ?
ICIoBRa -
ICIoBRa -

3 réponses
Modulo pour chiffres à virgule
cs_ebro -
Gally -

8 réponses
Rejoignez-nous