J
jonefer
I'm using a dual startup that 'ALMOST works...
It needs a refresh, but I'm not certain how, or where to put it.
The code is in the splash form. It checks the users group. If the user is
in MIS, it allows everything to be unlocked - toolbars, menus. etc. If the
user is NOT in the MIS group, then everything should be locked down.
However, the way it works now is that if the user is MIS and the last user
was not, they will not see all of the menus and tool bars. And if a non-MIS
user follows an MIS user, that user will see all of the toolbars and menus.
The user needs to login twice to see the changes take effect.
I am using 2 public functions:
ChangeProperty
GroupScore
These are called in the splash form.
'================code===============================
Public Function ChangeProperty(strPropName As String, varPropType As
Variant, varPropValue As Variant) As Integer
Dim dbs As Object, prp As Variant
Const conPropNotFoundError = 3270
Set dbs = CurrentDb
On Error GoTo Change_Err
dbs.Properties(strPropName) = varPropValue
ChangeProperty = True
Change_Bye:
Exit Function
Change_Err:
If Err = conPropNotFoundError Then ' Property not found.
Set prp = dbs.CreateProperty(strPropName, _
varPropType, varPropValue)
dbs.Properties.Append prp
Resume Next
Else
' Unknown error.
ChangeProperty = False
Resume Change_Bye
End If
End Function
Public Function GroupScore() As Long
'--- this function assigns a score to a user based on which groups they are in
'
' assigned group scores are:
' Users = 2
' ComInqs = 4
' MIS = 8
' MultiDepartment = 16
' ?? = 32
' ?? = 64
' ?? = 128
' Admins = 256
Dim wrk As DAO.Workspace
Dim usr As DAO.User
Dim grp As DAO.Group
Dim tmpScore As Long
Set wrk = DBEngine.Workspaces(0)
Set usr = wrk.Users(CurrentUser())
tmpScore = 0
'--- loop through all the groups that the user belongs to
For Each grp In usr.Groups
Select Case grp.Name
Case "Users"
tmpScore = tmpScore + 2
Case "ComInqs"
tmpScore = tmpScore + 4
Case "MIS"
tmpScore = tmpScore + 8
Case "MultiDepartment"
tmpScore = tmpScore + 16
Case "Admins"
tmpScore = tmpScore + 256
End Select
Next grp
GroupScore = tmpScore
End Function
'This code is in the splash form
If (GroupScore() And 8) <> 8 Then
'lock everything
ChangeProperty "StartupShowDBWindow", dbBoolean, False
ChangeProperty "AllowBuiltinToolbars", dbBoolean, False
ChangeProperty "AllowFullMenus", dbBoolean, False
ChangeProperty "AllowBreakIntoCode", dbBoolean, False
ChangeProperty "AllowSpecialKeys", dbBoolean, False
ChangeProperty "AllowBypassKey", dbBoolean, False
Else 'For effect...This form stays open
ChangeProperty "StartupShowDBWindow", dbBoolean, False
ChangeProperty "AllowBuiltinToolbars", dbBoolean, False
ChangeProperty "AllowFullMenus", dbBoolean, False
ChangeProperty "AllowBreakIntoCode", dbBoolean, False
ChangeProperty "AllowSpecialKeys", dbBoolean, False
ChangeProperty "AllowBypassKey", dbBoolean, False
End If
'==================================================
Much thanks in advance.
It needs a refresh, but I'm not certain how, or where to put it.
The code is in the splash form. It checks the users group. If the user is
in MIS, it allows everything to be unlocked - toolbars, menus. etc. If the
user is NOT in the MIS group, then everything should be locked down.
However, the way it works now is that if the user is MIS and the last user
was not, they will not see all of the menus and tool bars. And if a non-MIS
user follows an MIS user, that user will see all of the toolbars and menus.
The user needs to login twice to see the changes take effect.
I am using 2 public functions:
ChangeProperty
GroupScore
These are called in the splash form.
'================code===============================
Public Function ChangeProperty(strPropName As String, varPropType As
Variant, varPropValue As Variant) As Integer
Dim dbs As Object, prp As Variant
Const conPropNotFoundError = 3270
Set dbs = CurrentDb
On Error GoTo Change_Err
dbs.Properties(strPropName) = varPropValue
ChangeProperty = True
Change_Bye:
Exit Function
Change_Err:
If Err = conPropNotFoundError Then ' Property not found.
Set prp = dbs.CreateProperty(strPropName, _
varPropType, varPropValue)
dbs.Properties.Append prp
Resume Next
Else
' Unknown error.
ChangeProperty = False
Resume Change_Bye
End If
End Function
Public Function GroupScore() As Long
'--- this function assigns a score to a user based on which groups they are in
'
' assigned group scores are:
' Users = 2
' ComInqs = 4
' MIS = 8
' MultiDepartment = 16
' ?? = 32
' ?? = 64
' ?? = 128
' Admins = 256
Dim wrk As DAO.Workspace
Dim usr As DAO.User
Dim grp As DAO.Group
Dim tmpScore As Long
Set wrk = DBEngine.Workspaces(0)
Set usr = wrk.Users(CurrentUser())
tmpScore = 0
'--- loop through all the groups that the user belongs to
For Each grp In usr.Groups
Select Case grp.Name
Case "Users"
tmpScore = tmpScore + 2
Case "ComInqs"
tmpScore = tmpScore + 4
Case "MIS"
tmpScore = tmpScore + 8
Case "MultiDepartment"
tmpScore = tmpScore + 16
Case "Admins"
tmpScore = tmpScore + 256
End Select
Next grp
GroupScore = tmpScore
End Function
'This code is in the splash form
If (GroupScore() And 8) <> 8 Then
'lock everything
ChangeProperty "StartupShowDBWindow", dbBoolean, False
ChangeProperty "AllowBuiltinToolbars", dbBoolean, False
ChangeProperty "AllowFullMenus", dbBoolean, False
ChangeProperty "AllowBreakIntoCode", dbBoolean, False
ChangeProperty "AllowSpecialKeys", dbBoolean, False
ChangeProperty "AllowBypassKey", dbBoolean, False
Else 'For effect...This form stays open
ChangeProperty "StartupShowDBWindow", dbBoolean, False
ChangeProperty "AllowBuiltinToolbars", dbBoolean, False
ChangeProperty "AllowFullMenus", dbBoolean, False
ChangeProperty "AllowBreakIntoCode", dbBoolean, False
ChangeProperty "AllowSpecialKeys", dbBoolean, False
ChangeProperty "AllowBypassKey", dbBoolean, False
End If
'==================================================
Much thanks in advance.