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 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