Dual startup - needs refresh?

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

jonefer

Actually,
I found something better, but I was wondering how I could tweak it a bit.

Instead of setting all those properties
I did this on the splash form:

Dim i As Integer
For i = 1 To CommandBars.Count
CommandBars(i).Enabled = False
Next i

This is good, but a bit extreme.

Can I create an exception list, so that it keeps the basic close, open and
help menu there?
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top