[AC-2003] Accès à un formulaire [Résolu]

[lucas-18]

Bonjour,
Sur un formulaire frm_main, j'ai un bouton de commande qui permet d'ouvrir un formulaire frm_access.
Sur le frm_main, j'ai une zone de texte "User" avec comme source contrôle =Utilisateur()
J'aimerais pouvoir bloquer l'accès au frm_access à certains users quand je le désire et leur redonner accès.
Pour cela, j'ai crée une table tbl_access avec les champs suivants :
User : texte
Validation : Yes/No

Sur mon bouton de commande, j'ai le code suivant mais il ne fonctionne pas :

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Private Sub Commande74_Click()
On Error GoTo Err_Commande74_Click
 
    Dim stDocName As String
    Dim stLinkCriteria As String
 
If User = "TM14LD" Then
    If tbl_access.User = "TM14LD" And tbl_access.validation = True Then
        MsgBox "You don't have permission to open this window !", vbExclamation, "CTX"
        End If
        Else
    stDocName = "frm_access"
    DoCmd.OpenForm stDocName, , , stLinkCriteria
  End If
 
Exit_Commande74_Click:
    Exit Sub
 
Err_Commande74_Click:
    MsgBox Err.Description
    Resume Exit_Commande74_Click
 
End Sub

[Beub']

Bonjour,

Et... l'erreur vient de quelle ligne ?

A vue de nez, je dirais la ligne 8 ; tbl_access est une table, dc tu ne peux pas l'atteindre comme ça.
Apparemment, ta fontion "utilisateur()" te permet d'identifier l'utilisateur. A partir de là :
- Requête sur tbl_access pour identifier les droits correspondants au nom de l'utilisateur (donc qqc comme :

Code :

rqsql = "Select Validation FROM tbl_access WHERE Utilisateur = " & User

)
- Exécution de la requête.
- Test sur le résultat (si le résultat, dans le recordset, est True, ouverture, sinon, msgbox). Un peu comme ce que tu fais là !

Cordialement,
Beub'.

[lucas-18]

Oui l'erreur vient bien au départ de la ligne 8.
Mais je ne sais vraiment pas comment m'y prendre pour incorporer le sql dans le code ...

[lucas-18]

J'ai un peu avancé

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
Private Sub Commande79_Click()
On Error GoTo Err_Commande79_Click
 
Dim db As DAO.Database
Set db = CurrentDb()
Dim reqSQL As String
Dim nbRcds As Long
Dim rcds As DAO.Recordset
 
reqSQL = "Select Validation FROM tbl_access WHERE Utilisateur = User"
Set rcds = db.OpenRecordset(reqSQL)
        If rcds.EOF Then
        nbRcds = 0
        Else
        rcds.MoveLast
        nbRcds = rcds.RecordCount
        End If
Set db = Nothing
Set rcds = Nothing
 
Exit_Commande79_Click:
    Exit Sub
 
Err_Commande79_Click:
    MsgBox Err.Description
    Resume Exit_Commande79_Click
 
End Sub

Suis-je sur la bonne voie ?
J'aimerais aussi savoir comment mettre une condition sur le résultat de ce requête ?

Code :

1
2
3
4
5
6
If ...
Msgbox        
Else
    stDocName = "frm_access"
    DoCmd.OpenForm stDocName, , , stLinkCriteria
End If

[Beub']

Bonjour,

Tu es effectivement sur la bonne voie ! Reste à identifier ensuite les tests exacts que tu souhaites effectuer..! A titre d'exemple :

Est-il possible d'avoir plusieurs utilisateurs enregistrés sous le même nom dans cette table ? Par exemple :
- User1 avec Validation = TRUE
- User2 avec Validation = TRUE
- User3 avec Validation = FALSE
- User1 avec Validation = FALSE

Dans ce cas, ta requête (sur User1) retournerait deux résultats => lequel devra être pris en compte ? True ou False ?

De même, que se passe-t-il si aucun résultat n'est retourné par la requête ?

Petit morceau de code (non testé mais je crois que je n'ai pas pris de risque..)

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Set rcds = db.OpenRecordset(reqSQL)
 
    'On se place sur le premier enregistrement
    rcds.MoveFirst
    'Si plus d'un enregistrement, dans tbl_access, est retourné, on n'effectue pas le code
    If rcds.RecordCount = 1 Then
        'Test de la valeur de Validation
        If rcds![Validation] = True Then
            MsgBox "Droits d'accès OK"
        Else
            MsgBox "Accès refusé"
        End If
    End If
 
Set db = Nothing
Set rcds = Nothing

Essaie de t'aider de ça. Et évite d'entrer "en dur" les paramètres de ta requête (notamment le "Utilisateur = 'User'").
Pour tester le contenu de ton recordset : NomDuRecordset!["NomDuChamp"] !

En espérant que ça t'aidera.

Cordialement,
Beub'

[lucas-18]

Envoyé par Beub'

Bonjour,

Tu es effectivement sur la bonne voie ! Reste à identifier ensuite les tests exacts que tu souhaites effectuer..! A titre d'exemple :

Est-il possible d'avoir plusieurs utilisateurs enregistrés sous le même nom dans cette table ? Par exemple :
- User1 avec Validation = TRUE
- User2 avec Validation = TRUE
- User3 avec Validation = FALSE
- User1 avec Validation = FALSE

Dans ce cas, ta requête (sur User1) retournerait deux résultats => lequel devra être pris en compte ? True ou False ?

De même, que se passe-t-il si aucun résultat n'est retourné par la requête ?

Petit morceau de code (non testé mais je crois que je n'ai pas pris de risque..)

Code :

Essaie de t'aider de ça. Et évite d'entrer "en dur" les paramètres de ta requête (notamment le "Utilisateur = 'User'").
Pour tester le contenu de ton recordset : NomDuRecordset!["NomDuChamp"] !

En espérant que ça t'aidera.

Cordialement,
Beub'

Bonjour Beub' et merci pour ta réponse.

Non il n'est pas possible qu'il y ait plusieurs mêmes users.
User (texte)------Validation(Oui/Non)
Jean-------------True
Marc-------------False
Sébastien--------True
etc etc

J'ai essayé le code suivant mais lorsque je click sur le bouton de commande qui me permet d'ouvrir ou non le formulaire frm_access, il m'indique un message : "Trop peu de paramètre. 1 attendu".

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
Private Sub Commande79_Click()
On Error GoTo Err_Commande79_Click
 
Dim db As DAO.Database
Set db = CurrentDb()
Dim reqSQL As String
Dim nbRcds As Long
Dim rcds As DAO.Recordset
 
reqSQL = "Select Validation FROM tbl_access WHERE Utilisateur = User"
Set rcds = db.OpenRecordset(reqSQL)
 
    rcds.MoveFirst
    If rcds.RecordCount = 1 Then
        If rcds![Validation] = True Then
               DoCmd.OpenForm "frm_access"
        Else
            MsgBox "Accès refusé"
        End If
    End If
 
Set db = Nothing
Set rcds = Nothing
 
        If rcds.EOF Then
        nbRcds = 0
        Else
        rcds.MoveLast
        nbRcds = rcds.RecordCount
        End If
Set db = Nothing
Set rcds = Nothing
 
Exit_Commande79_Click:
    Exit Sub
 
Err_Commande79_Click:
    MsgBox Err.Description
    Resume Exit_Commande79_Click
 
End Sub

[Beub']

Bonjour,

Le problème vient de ta requête SQL.

Code :

reqSQL = "Select Validation FROM tbl_access WHERE Utilisateur = User"

User doit être placé entre simple quotes s'il s'agit d'une chaine de caractères.

S'il s'agit d'une variable, elle doit être "sortie" de la chaine de cette façon :

Code :

1
2
3
Dim User AS String
User = "UtilisateurTest"
reqSQL = "Select Validation FROM tbl_access WHERE Utilisateur = '" & User & "'"

D'après ta requête, User n'est pas reconnu comme un paramètre (chaine de caractères "en dur" => simple quote ; variable => "sortie" de la chaine), le message t'indique donc qu'il en manque un.

Je ne sais pas si je suis très clair mais, dans le pire des cas, go google pour la création de requêtes SQL en VBA Access

Cordialement,
Beub'.

[lucas-18]

Envoyé par Beub'

Bonjour,

Le problème vient de ta requête SQL.

Code :

reqSQL = "Select Validation FROM tbl_access WHERE Utilisateur = User"

User doit être placé entre simple quotes s'il s'agit d'une chaine de caractères.

S'il s'agit d'une variable, elle doit être "sortie" de la chaine de cette façon :

Code :

D'après ta requête, User n'est pas reconnu comme un paramètre (chaine de caractères "en dur" => simple quote ; variable => "sortie" de la chaine), le message t'indique donc qu'il en manque un.

Je ne sais pas si je suis très clair mais, dans le pire des cas, go google pour la création de requêtes SQL en VBA Access

Cordialement,
Beub'.

J'ai compris mais lorsque je lance le code suivant, il m'indique maintenant "Aucun enregistrement en cours" ...

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
Private Sub Commande79_Click()
On Error GoTo Err_Commande79_Click
 
Dim db As DAO.Database
Set db = CurrentDb()
Dim reqSQL As String
Dim nbRcds As Long
Dim rcds As DAO.Recordset
Dim User AS String
User = "UtilisateurTest"
reqSQL = "Select Validation FROM tbl_access WHERE Utilisateur = '" & User & "'"
Set rcds = db.OpenRecordset(reqSQL)
 
    rcds.MoveFirst
    If rcds.RecordCount = 1 Then
        If rcds![Validation] = True Then
               DoCmd.OpenForm "frm_access"
        Else
            MsgBox "Accès refusé"
        End If
    End If
 
Set db = Nothing
Set rcds = Nothing
 
        If rcds.EOF Then
        nbRcds = 0
        Else
        rcds.MoveLast
        nbRcds = rcds.RecordCount
        End If
Set db = Nothing
Set rcds = Nothing
 
Exit_Commande79_Click:
    Exit Sub
 
Err_Commande79_Click:
    MsgBox Err.Description
    Resume Exit_Commande79_Click
 
End Sub

[lucas-18]

Enfin ca marche avec le code suivant mais j'ai un message :

Variable objet ou variable de bloc With non définie

Comment cela se fait ?

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
Private Sub Commande79_Click()
On Error GoTo Err_Commande79_Click
 
Dim db As DAO.Database
Set db = CurrentDb()
Dim reqSQL As String
Dim nbRcds As Long
Dim rcds As DAO.Recordset
Dim User As String
 
reqSQL = "Select Validation FROM tbl_access WHERE Utilisateur='" & User & "'"
 
Set rcds = db.OpenRecordset(reqSQL)
 
    rcds.MoveFirst
    If rcds.RecordCount = 1 Then
        If rcds![Validation] = True Then
               DoCmd.OpenForm "frm_access"
        Else
            MsgBox "Accès refusé"
        End If
    End If
 
Set db = Nothing
Set rcds = Nothing
 
        If rcds.EOF Then
        nbRcds = 0
        Else
        rcds.MoveLast
        nbRcds = rcds.RecordCount
        End If
Set db = Nothing
Set rcds = Nothing
 
Exit_Commande79_Click:
    Exit Sub
 
Err_Commande79_Click:
    MsgBox Err.Description
    Resume Exit_Commande79_Click
 
End Sub

[lucas-18]

Ca marche !!! J'ai juste supprimé les variables avec valeur nothing