How to correct this function for usernames

mana

Registered User.
Local time
Today, 03:19
Joined
Nov 4, 2014
Messages
265
Hello

i have the following function

Function Get_Bearbeiter_Detail(ByVal vBearbeiter_Code As String, Optional ByRef vBearbeiter_Name As String, Optional ByRef vReadOnly_Flag As Boolean, Optional ByRef vAnalyser_Flag As Boolean, Optional ByRef vAdmin_Flag As Boolean) As Boolean
On Error GoTo Err
DoCmd.Hourglass True

Dim rst As ADODB.Recordset

Set rst = New ADODB.Recordset
rst.CursorLocation = adUseClient

Dim cmd As ADODB.Command
Set cmd = New ADODB.Command

Dim prm As ADODB.Parameter
Set prm = New ADODB.Parameter

With cmd
.ActiveConnection = CurrentProject.AccessConnection
.CommandText = "qry_mgntUserManagement"
.CommandType = adCmdTable
.NamedParameters = True
Set prm = .CreateParameter("@Bearbeiter_Code?", adVarChar, adParamInput, 10, vBearbeiter_Code)
.Parameters.Append prm



'rst.Open
Set rst = .Execute
End With



If Not rst.EOF Then
With rst
vBearbeiter_Name = !Username
vReadOnly_Flag = !ReadOnly_Flag
vAnalyser_Flag = !Analyser_Flag
vAdmin_Flag = !Admin_Flag
End With
Get_Bearbeiter_Detail = True
Else
With rst
vBearbeiter_Name = "Nicht Autorisiert"
vReadOnly_Flag = False
vAnalyser_Flag = False
vAdmin_Flag = False
End With
Get_Bearbeiter_Detail = False
End If

DoCmd.Hourglass False

rst.Close
Set cmd = Nothing
Set prm = Nothing
Set rst = Nothing
'End If

Exit Function
Err:
DoCmd.Hourglass False
MsgBox "Leider hat diese Funktion einen Fehler ausgelöst - bitte wenden Sie sich and die EDV! - (Get_Bearbeiter_Detail - '" & Err.Description & "')"
End Function

and i use it in open event of my form as below:
Dim vAdmin_Flag As Boolean
Dim vAnalyser_Flag As Boolean
Dim vReadOnly_Flag As Boolean

Call Menubar_ausblenden

Dim vBearbeiter_Name As String
Call Get_Bearbeiter_Detail(fOSUserName, vBearbeiter_Name)
If vBearbeiter_Name <> "Nicht Autorisiert" Then
If Get_Bearbeiter_Detail(fOSUserName, , vReadOnly_Flag, vAnalyser_Flag, vAdmin_Flag) = True Then
If vAdmin_Flag = True And vAnalyser_Flag = True And vReadOnly_Flag = True Then
DoCmd.OpenForm "frm_mainmenü"
ElseIf vAdmin_Flag = True Then
DoCmd.OpenForm "frm_mainmenü"
ElseIf vAdmin_Flag = False And (vAnalyser_Flag = True Or vReadOnly_Flag = True) Then
[Forms]![frm_mainmenü]![Command265].Enabled = False
ElseIf vAdmin_Flag = False And vAnalyser_Flag = False And vReadOnly_Flag = False Then
MsgBox "Sie sind leider nicht berechtigt diese Funktion auszuführen!", vbCritical
DoCmd.Close acForm, "frm_mainmenü"
End If
Else
MsgBox "Sie sind leider nicht berechtigt diese Funktion auszuführen!", vbCritical
DoCmd.Close acForm, "frm_mainmenü"
End If
Else
MsgBox "Sie sind leider nicht berechtigt diese Anwendung auszuführen!", vbCritical
DoCmd.Close acForm, "frm_mainmenü"
End If

before it worked correct but now i have this error message :
"Sie sind leider nicht berechtigt diese Anwendung auszuführen!",
i don't know why i have this error
can you help me please?
thank you
 
I have reformatted your code with Smart Indenter to make it more readable.

Code:
Function Get_Bearbeiter_Detail(ByVal vBearbeiter_Code As String, Optional ByRef vBearbeiter_Name As String, Optional ByRef vReadOnly_Flag As Boolean, Optional ByRef vAnalyser_Flag As Boolean, Optional ByRef vAdmin_Flag As Boolean) As Boolean
    On Error GoTo Err
    DoCmd.Hourglass True

    Dim rst As ADODB.Recordset

    Set rst = New ADODB.Recordset
    rst.CursorLocation = adUseClient

    Dim cmd As ADODB.Command
    Set cmd = New ADODB.Command

    Dim prm As ADODB.Parameter
    Set prm = New ADODB.Parameter

    With cmd
        .ActiveConnection = CurrentProject.AccessConnection
        .CommandText = "qry_mgntUserManagement"
        .CommandType = adCmdTable
        .NamedParameters = True
        Set prm = .CreateParameter("@Bearbeiter_Code?", adVarChar, adParamInput, 10, vBearbeiter_Code)
        .Parameters.Append prm



        'rst.Open
        Set rst = .Execute
    End With



    If Not rst.EOF Then
        With rst
            vBearbeiter_Name = !UserName
            vReadOnly_Flag = !ReadOnly_Flag
            vAnalyser_Flag = !Analyser_Flag
            vAdmin_Flag = !Admin_Flag
        End With
        Get_Bearbeiter_Detail = True
    Else
        With rst
            vBearbeiter_Name = "Nicht Autorisiert"
            vReadOnly_Flag = False
            vAnalyser_Flag = False
            vAdmin_Flag = False
        End With
        Get_Bearbeiter_Detail = False
    End If

    DoCmd.Hourglass False

    rst.Close
    Set cmd = Nothing
    Set prm = Nothing
    Set rst = Nothing
    'End If

    Exit Function
Err:
    DoCmd.Hourglass False
    MsgBox "Leider hat diese Funktion einen Fehler ausgelöst - bitte wenden Sie sich and die EDV! - (Get_Bearbeiter_Detail - '" & Err.Description & "')"
End Function

and i use it in open event of my form as below:

Code:
Dim vAdmin_Flag As Boolean
Dim vAnalyser_Flag As Boolean
Dim vReadOnly_Flag As Boolean

Call Menubar_ausblenden

Dim vBearbeiter_Name As String
Call Get_Bearbeiter_Detail(fOSUserName, vBearbeiter_Name)
If vBearbeiter_Name <> "Nicht Autorisiert" Then
    If Get_Bearbeiter_Detail(fOSUserName, , vReadOnly_Flag, vAnalyser_Flag, vAdmin_Flag) = True Then
        If vAdmin_Flag = True And vAnalyser_Flag = True And vReadOnly_Flag = True Then
            DoCmd.OpenForm "frm_mainmenü"
        ElseIf vAdmin_Flag = True Then
            DoCmd.OpenForm "frm_mainmenü"
        ElseIf vAdmin_Flag = False And (vAnalyser_Flag = True Or vReadOnly_Flag = True) Then
            [Forms]![frm_mainmenü]![Command265].Enabled = False
        ElseIf vAdmin_Flag = False And vAnalyser_Flag = False And vReadOnly_Flag = False Then
            MsgBox "Sie sind leider nicht berechtigt diese Funktion auszuführen!", vbCritical
            DoCmd.Close acForm, "frm_mainmenü"
        End If
    Else
        MsgBox "Sie sind leider nicht berechtigt diese Funktion auszuführen!", vbCritical
        DoCmd.Close acForm, "frm_mainmenü"
    End If
Else
    MsgBox "Sie sind leider nicht berechtigt diese Anwendung auszuführen!", vbCritical
    DoCmd.Close acForm, "frm_mainmenü"
End If

What did you change?

It appears that
If vBearbeiter_Name <> "Nicht Autorisiert"

is Not True - the name is "Nicht Autorisiert"

Have you checked your data, and stepped through the code?
We do not know your application.
 
Last edited:
i added a user in dbo.mgntUserManagement and the user is existed in qry_mgntUserManagement but there is the error
"Sie sind leider nicht berechtigt diese Anwendung auszuführen!",
that i wrote you for this user and i don't know why.
 
Put a breakpoint in your code, perhaps this line

If vBearbeiter_Name <> "Nicht Autorisiert" Then

then do some step debugging and check vBearbeiter_Name values...

The error is produced/displayed in the False part of the IF as I understand the code.
 

Users who are viewing this thread

Back
Top Bottom